aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/test/ets_SUITE.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/stdlib/test/ets_SUITE.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/stdlib/test/ets_SUITE.erl')
-rw-r--r--lib/stdlib/test/ets_SUITE.erl5355
1 files changed, 5355 insertions, 0 deletions
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
new file mode 100644
index 0000000000..6016bc9bdc
--- /dev/null
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -0,0 +1,5355 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ets_SUITE).
+
+-export([all/1]).
+-export([new/1,default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1,
+ privacy/1,privacy_owner/2]).
+-export([insert/1,empty/1,badinsert/1]).
+-export([lookup/1,time_lookup/1,badlookup/1,lookup_order/1]).
+-export([delete/1,delete_elem/1,delete_tab/1,delete_large_tab/1,
+ delete_large_named_table/1,
+ evil_delete/1,baddelete/1,match_delete/1,table_leak/1]).
+-export([match_delete3/1]).
+-export([firstnext/1,firstnext_concurrent/1]).
+-export([slot/1]).
+-export([match/1, match1/1, match2/1, match_object/1, match_object2/1]).
+-export([misc/1, dups/1, misc1/1, safe_fixtable/1, info/1, tab2list/1]).
+-export([files/1, tab2file/1, tab2file2/1, tab2file3/1, tabfile_ext1/1,
+ tabfile_ext2/1, tabfile_ext3/1, tabfile_ext4/1]).
+-export([heavy/1, heavy_lookup/1, heavy_lookup_element/1]).
+-export([lookup_element/1, lookup_element_mult/1]).
+-export([fold/1]).
+-export([foldl_ordered/1, foldr_ordered/1, foldl/1, foldr/1, fold_empty/1]).
+-export([t_delete_object/1, t_init_table/1, t_whitebox/1,
+ t_delete_all_objects/1, t_insert_list/1, t_test_ms/1,
+ t_select_delete/1,t_ets_dets/1]).
+
+-export([do_lookup/2, do_lookup_element/3]).
+
+-export([ordered/1, ordered_match/1, interface_equality/1,
+ fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1,
+ update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]).
+-export([member/1]).
+-export([memory/1]).
+-export([select_fail/1]).
+-export([t_insert_new/1]).
+-export([t_repair_continuation/1]).
+-export([t_match_spec_run/1]).
+-export([t_bucket_disappears/1]).
+-export([otp_5340/1]).
+-export([otp_6338/1]).
+-export([otp_6842_select_1000/1]).
+-export([otp_7665/1]).
+-export([meta_wb/1]).
+-export([grow_shrink/1, grow_pseudo_deleted/1, shrink_pseudo_deleted/1]).
+-export([meta_smp/1,
+ meta_lookup_unnamed_read/1, meta_lookup_unnamed_write/1,
+ meta_lookup_named_read/1, meta_lookup_named_write/1,
+ meta_newdel_unnamed/1, meta_newdel_named/1]).
+-export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, otp_8166/1]).
+-export([exit_large_table_owner/1,
+ exit_many_large_table_owner/1,
+ exit_many_tables_owner/1,
+ exit_many_many_tables_owner/1]).
+-export([write_concurrency/1, heir/1, give_away/1, setopts/1]).
+-export([bad_table/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]).
+%% Convenience for manual testing
+-export([random_test/0]).
+
+% internal exports
+-export([dont_make_worse_sub/0, make_better_sub1/0, make_better_sub2/0]).
+-export([t_repair_continuation_do/1, default_do/1, t_bucket_disappears_do/1,
+ select_fail_do/1, whitebox_1/1, whitebox_2/1, t_delete_all_objects_do/1,
+ t_delete_object_do/1, t_init_table_do/1, t_insert_list_do/1,
+ update_element_opts/1, update_element_opts/4, update_element/4, update_element_do/4,
+ update_element_neg/1, update_element_neg_do/1, update_counter_do/1, update_counter_neg/1,
+ evil_update_counter_do/1, fixtable_next_do/1, heir_do/1, give_away_do/1, setopts_do/1,
+ rename_do/1, rename_unnamed_do/1, interface_equality_do/1, ordered_match_do/1,
+ ordered_do/1, privacy_do/1, empty_do/1, badinsert_do/1, time_lookup_do/1,
+ lookup_order_do/1, lookup_element_mult_do/1, delete_tab_do/1, delete_elem_do/1,
+ match_delete_do/1, match_delete3_do/1, firstnext_do/1,
+ slot_do/1, match1_do/1, match2_do/1, match_object_do/1, match_object2_do/1,
+ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1,
+ heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1
+ ]).
+
+-include("test_server.hrl").
+
+init_per_testcase(Case, Config) ->
+ Seed = {S1,S2,S3} = random:seed0(), %now(),
+ random:seed(S1,S2,S3),
+ io:format("*** SEED: ~p ***\n", [Seed]),
+ start_spawn_logger(),
+ wait_for_test_procs(), %% Ensure previous case cleaned up
+ Dog=test_server:timetrap(test_server:minutes(20)),
+ [{watchdog, Dog}, {test_case, Case} | Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ wait_for_test_procs(true),
+ test_server:timetrap_cancel(Dog).
+
+
+end_per_suite(_Config) ->
+ stop_spawn_logger(),
+ catch erts_debug:set_internal_state(available_internal_state, false).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+all(suite) ->
+ [
+ new,insert,lookup,delete,firstnext,firstnext_concurrent,slot,match,
+ t_match_spec_run,
+ lookup_element, misc,files, heavy,
+ ordered, ordered_match, interface_equality,
+ fixtable_next, fixtable_insert, rename, rename_unnamed, evil_rename,
+ update_element, update_counter, evil_update_counter, partly_bound,
+ match_heavy, fold, member,
+ t_delete_object, t_init_table, t_whitebox,
+ t_delete_all_objects, t_insert_list, t_test_ms,
+ t_select_delete, t_ets_dets, memory,
+ t_bucket_disappears,
+ select_fail,t_insert_new, t_repair_continuation, otp_5340, otp_6338,
+ otp_6842_select_1000, otp_7665,
+ meta_wb,
+ grow_shrink, grow_pseudo_deleted, shrink_pseudo_deleted,
+ meta_smp,
+ smp_insert, smp_fixed_delete, smp_unfix_fix, smp_select_delete, otp_8166,
+ exit_large_table_owner,
+ exit_many_large_table_owner,
+ exit_many_tables_owner,
+ exit_many_many_tables_owner,
+ write_concurrency, heir, give_away, setopts,
+ bad_table
+ ].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+t_bucket_disappears(suite) ->
+ [];
+t_bucket_disappears(doc) ->
+ ["Test that a disappearing bucket during select of a non-fixed table works."];
+t_bucket_disappears(Config) when is_list(Config) ->
+ repeat_for_opts(t_bucket_disappears_do).
+
+t_bucket_disappears_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line ets:new(abcd, [named_table, public, {keypos, 2} | Opts]),
+ ?line ets:insert(abcd, {abcd,1,2}),
+ ?line ets:insert(abcd, {abcd,2,2}),
+ ?line ets:insert(abcd, {abcd,3,2}),
+ ?line {_, Cont} = ets:select(abcd, [{{'_', '$1', '_'},
+ [{'<', '$1', {const, 10}}],
+ ['$1']}], 1),
+ ?line ets:delete(abcd, 2),
+ ?line ets:select(Cont),
+ ?line true = ets:delete(abcd),
+ ?line verify_etsmem(EtsMem).
+
+
+t_match_spec_run(suite) ->
+ [];
+t_match_spec_run(doc) ->
+ ["Check ets:match_spec_run/2."];
+t_match_spec_run(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line [2,3] = ets:match_spec_run([{1},{2},{3}],
+ ets:match_spec_compile(
+ [{{'$1'},[{'>','$1',1}],['$1']}])),
+ ?line Huge = [{X} || X <- lists:seq(1,2500)],
+ ?line L = lists:seq(2476,2500),
+ ?line L = ets:match_spec_run(Huge,
+ ets:match_spec_compile(
+ [{{'$1'},[{'>','$1',2475}],['$1']}])),
+ ?line L2 = [{X*16#FFFFFFF} || X <- L],
+ ?line L2 = ets:match_spec_run(Huge,
+ ets:match_spec_compile(
+ [{{'$1'},
+ [{'>','$1',2475}],
+ [{{{'*','$1',16#FFFFFFF}}}]}])),
+ ?line [500,1000,1500,2000,2500] =
+ ets:match_spec_run(Huge,
+ ets:match_spec_compile(
+ [{{'$1'},
+ [{'=:=',{'rem','$1',500},0}],
+ ['$1']}])),
+ ?line verify_etsmem(EtsMem).
+
+
+
+t_repair_continuation(suite) ->
+ [];
+t_repair_continuation(doc) ->
+ ["Check ets:repair_continuation/2."];
+t_repair_continuation(Config) when is_list(Config) ->
+ repeat_for_opts(t_repair_continuation_do).
+
+
+t_repair_continuation_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line MS = [{'_',[],[true]}],
+ ?line MS2 = [{{{'$1','_'},'_'},[],['$1']}],
+ (fun() ->
+ ?line T = ets:new(x,[ordered_set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{N,N}), F(N-1,F) end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(5,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ (fun() ->
+ ?line T = ets:new(x,[ordered_set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) -> ets:insert(T,{N,N}), F(N-1,F) end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,1001),
+ ?line C = '$end_of_table',
+ ?line C3 = ets:repair_continuation(C,MS),
+ ?line '$end_of_table' = ets:select(C3),
+ ?line '$end_of_table' = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+
+ (fun() ->
+ ?line T = ets:new(x,[ordered_set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{integer_to_list(N),N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(5,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ (fun() ->
+ ?line T = ets:new(x,[ordered_set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{{integer_to_list(N),N},N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS2,5),
+ ?line C2 = erlang:setelement(5,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS2),
+ ?line {[_,_,_,_,_],_} = ets:select(C3),
+ ?line {[_,_,_,_,_],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+
+ (fun() ->
+ ?line T = ets:new(x,[set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{N,N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(4,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ (fun() ->
+ ?line T = ets:new(x,[set|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{integer_to_list(N),N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(4,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ (fun() ->
+ ?line T = ets:new(x,[bag|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{integer_to_list(N),N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(4,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ (fun() ->
+ ?line T = ets:new(x,[duplicate_bag|Opts]),
+ ?line F = fun(0,_)->ok;(N,F) ->
+ ets:insert(T,{integer_to_list(N),N}),
+ F(N-1,F)
+ end,
+ ?line F(1000,F),
+ ?line {_,C} = ets:select(T,MS,5),
+ ?line C2 = erlang:setelement(4,C,<<>>),
+ ?line {'EXIT',{badarg,_}} = (catch ets:select(C2)),
+ ?line C3 = ets:repair_continuation(C2,MS),
+ ?line {[true,true,true,true,true],_} = ets:select(C3),
+ ?line {[true,true,true,true,true],_} = ets:select(C),
+ ?line true = ets:delete(T)
+ end)(),
+ ?line false = ets:is_compiled_ms(<<>>),
+ ?line true = ets:is_compiled_ms(ets:match_spec_compile(MS)),
+ ?line verify_etsmem(EtsMem).
+
+new(suite) -> [default,setbag,badnew,verybadnew,named,keypos2,privacy].
+
+default(doc) ->
+ ["Test case to check that a new ets table is defined as a `set' and "
+ "`protected'"];
+default(suite) -> [];
+default(Config) when is_list(Config) ->
+ %% Default should be set,protected
+ repeat_for_opts(default_do).
+
+default_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Def = ets:new(def,Opts),
+ ?line set = ets:info(Def,type),
+ ?line protected = ets:info(Def,protection),
+ ?line ets:delete(Def),
+ ?line verify_etsmem(EtsMem).
+
+select_fail(doc) ->
+ ["Test that select fails even if nothing can match"];
+select_fail(suite) ->
+ [];
+select_fail(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(select_fail_do, [all_types,write_concurrency]),
+ ?line verify_etsmem(EtsMem).
+
+select_fail_do(Opts) ->
+ ?line T = ets:new(x,Opts),
+ ?line ets:insert(T,{a,a}),
+ ?line case (catch
+ ets:select(T,[{{a,'_'},[],[{snuffla}]}])) of
+ {'EXIT',{badarg,_}} ->
+ ok;
+ Else0 ->
+ exit({type,ets:info(T,type),
+ expected,'EXIT',got,Else0})
+ end,
+ ?line case (catch
+ ets:select(T,[{{b,'_'},[],[{snuffla}]}])) of
+ {'EXIT',{badarg,_}} ->
+ ok;
+ Else1 ->
+ exit({type,ets:info(T,type),
+ expected,'EXIT',got,Else1})
+ end,
+ ?line ets:delete(T).
+
+
+-define(S(T),ets:info(T,memory)).
+-define(TAB_STRUCT_SZ, erts_debug:get_internal_state('DbTable_words')).
+-define(NORMAL_TAB_STRUCT_SZ, 26). %% SunOS5.8, 32-bit, non smp, private heap
+%%
+%% The hardcoded expected memory sizes (in words) are the ones we expect on:
+%% SunOS5.8, 32-bit, non smp, private heap
+%%
+memory(doc) ->
+ ["Whitebox test of ets:info(X,memory)"];
+memory(suite) ->
+ [];
+memory(Config) when is_list(Config) ->
+ ?line erts_debug:set_internal_state(available_internal_state, true),
+ ?line ok = chk_normal_tab_struct_size(),
+ ?line L = [T1,T2,T3,T4] = fill_sets_int(1000),
+ ?line XRes1 = adjust_xmem(L, {16862,16072,16072,16078}),
+ ?line Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)},
+ ?line lists:foreach(fun(T) ->
+ Before = ets:info(T,size),
+ Key = 2, %894, %%ets:first(T),
+ Objs = ets:lookup(T,Key),
+ ?line ets:delete(T,Key),
+ io:format("deleted key ~p from ~p changed size ~p to ~p: ~p\n",
+ [Key, ets:info(T,type), Before, ets:info(T,size), Objs])
+ end,
+ L),
+ ?line XRes2 = adjust_xmem(L, {16849,16060,16048,16054}),
+ ?line Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)},
+ ?line lists:foreach(fun(T) ->
+ Before = ets:info(T,size),
+ Key = 4, %802, %ets:first(T),
+ Objs = ets:lookup(T,Key),
+ ?line ets:match_delete(T,{Key,'_'}),
+ io:format("match_deleted key ~p from ~p changed size ~p to ~p: ~p\n",
+ [Key, ets:info(T,type), Before, ets:info(T,size), Objs])
+ end,
+ L),
+ ?line XRes3 = adjust_xmem(L, {16836,16048,16024,16030}),
+ ?line Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)},
+ ?line lists:foreach(fun(T) ->
+ ?line ets:delete_all_objects(T)
+ end,
+ L),
+ ?line XRes4 = adjust_xmem(L, {76,286,286,286}),
+ ?line Res4 = {?S(T1),?S(T2),?S(T3),?S(T4)},
+ lists:foreach(fun(T) ->
+ ?line ets:delete(T)
+ end,
+ L),
+ ?line L2 = [T11,T12,T13,T14] = fill_sets_int(1000),
+ ?line lists:foreach(fun(T) ->
+ ?line ets:select_delete(T,[{'_',[],[true]}])
+ end,
+ L2),
+ ?line XRes5 = adjust_xmem(L2, {76,286,286,286}),
+ ?line Res5 = {?S(T11),?S(T12),?S(T13),?S(T14)},
+ ?line ?t:format("XRes1 = ~p~n"
+ " Res1 = ~p~n~n"
+ "XRes2 = ~p~n"
+ " Res2 = ~p~n~n"
+ "XRes3 = ~p~n"
+ " Res3 = ~p~n~n"
+ "XRes4 = ~p~n"
+ " Res4 = ~p~n~n"
+ "XRes5 = ~p~n"
+ " Res5 = ~p~n~n",
+ [XRes1, Res1,
+ XRes2, Res2,
+ XRes3, Res3,
+ XRes4, Res4,
+ XRes5, Res5]),
+ ?line XRes1 = Res1,
+ ?line XRes2 = Res2,
+ ?line XRes3 = Res3,
+ ?line XRes4 = Res4,
+ ?line XRes5 = Res5,
+ ?line catch erts_debug:set_internal_state(available_internal_state, false),
+ ?line ok.
+
+chk_normal_tab_struct_size() ->
+ ?line System = {os:type(),
+ os:version(),
+ erlang:system_info(wordsize),
+ erlang:system_info(smp_support),
+ erlang:system_info(heap_type)},
+ ?line ?t:format("System = ~p~n", [System]),
+ ?line ?t:format("?NORMAL_TAB_STRUCT_SZ=~p~n", [?NORMAL_TAB_STRUCT_SZ]),
+ ?line ?t:format("?TAB_STRUCT_SZ=~p~n", [?TAB_STRUCT_SZ]),
+ ?line case System of
+ {{unix, sunos}, {5, 8, 0}, 4, false, private} ->
+ ?line ?NORMAL_TAB_STRUCT_SZ = ?TAB_STRUCT_SZ,
+ ?line ok;
+ _ ->
+ ?line ok
+ end.
+
+adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = Mem0) ->
+ %% Adjust for 64-bit, smp, and os:
+ %% Table struct size may differ.
+ Mem1 = case ?TAB_STRUCT_SZ of
+ ?NORMAL_TAB_STRUCT_SZ ->
+ Mem0;
+ TabStructSz ->
+ TabDiff = TabStructSz - ?NORMAL_TAB_STRUCT_SZ,
+ {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}
+ end,
+ %% Adjust for hybrid and shared heaps:
+ %% Each record is one word smaller.
+ Mem2 = case erlang:system_info(heap_type) of
+ private ->
+ Mem1;
+ _ ->
+ {A1,B1,C1,D1} = Mem1,
+ {A1-ets:info(T1, size),B1-ets:info(T2, size),
+ C1-ets:info(T3, size),D1-ets:info(T4, size)}
+ end,
+ %%{Mem2,{ets:info(T1,stats),ets:info(T2,stats),ets:info(T3,stats),ets:info(T4,stats)}}.
+ Mem2.
+
+t_whitebox(doc) ->
+ ["Diverse whitebox testes"];
+t_whitebox(suite) ->
+ [];
+t_whitebox(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(whitebox_1),
+ repeat_for_opts(whitebox_1),
+ repeat_for_opts(whitebox_1),
+ repeat_for_opts(whitebox_2),
+ repeat_for_opts(whitebox_2),
+ repeat_for_opts(whitebox_2),
+ ?line verify_etsmem(EtsMem).
+
+whitebox_1(Opts) ->
+ ?line T=ets:new(x,[bag | Opts]),
+ ?line ets:insert(T,[{du,glade},{ta,en}]),
+ ?line ets:insert(T,[{hej,hopp2},{du,glade2},{ta,en2}]),
+ ?line {_,C}=ets:match(T,{ta,'$1'},1),
+ ?line ets:select(C),
+ ?line ets:match(C),
+ ?line ets:delete(T),
+ ok.
+
+whitebox_2(Opts) ->
+ ?line T=ets:new(x,[ordered_set, {keypos,2} | Opts]),
+ ?line T2=ets:new(x,[set, {keypos,2}| Opts]),
+ ?line 0 = ets:select_delete(T,[{{hej},[],[true]}]),
+ ?line 0 = ets:select_delete(T,[{{hej,hopp},[],[true]}]),
+ ?line 0 = ets:select_delete(T2,[{{hej},[],[true]}]),
+ ?line 0 = ets:select_delete(T2,[{{hej,hopp},[],[true]}]),
+ ?line ets:delete(T),
+ ?line ets:delete(T2),
+ ok.
+
+
+t_ets_dets(doc) ->
+ ["Test ets:to/from_dets"];
+t_ets_dets(suite) ->
+ [];
+t_ets_dets(Config) when is_list(Config) ->
+ repeat_for_opts(fun(Opts) -> t_ets_dets(Config,Opts) end).
+
+t_ets_dets(Config, Opts) ->
+ ?line Fname = gen_dets_filename(Config,1),
+ ?line (catch file:delete(Fname)),
+ ?line {ok,DTab} = dets:open_file(testdets_1,
+ [{file, Fname}]),
+ ?line ETab = ets:new(x,Opts),
+ ?line filltabint(ETab,3000),
+ ?line DTab = ets:to_dets(ETab,DTab),
+ ?line ets:delete_all_objects(ETab),
+ ?line 0 = ets:info(ETab,size),
+ ?line true = ets:from_dets(ETab,DTab),
+ ?line 3000 = ets:info(ETab,size),
+ ?line ets:delete(ETab),
+ ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab]}|_]}} =
+ (catch ets:to_dets(ETab,DTab)),
+ ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab]}|_]}} =
+ (catch ets:from_dets(ETab,DTab)),
+ ?line ETab2 = ets:new(x,Opts),
+ ?line filltabint(ETab2,3000),
+ ?line dets:close(DTab),
+ ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab]}|_]}} =
+ (catch ets:to_dets(ETab2,DTab)),
+ ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab]}|_]}} =
+ (catch ets:from_dets(ETab2,DTab)),
+ ?line ets:delete(ETab2),
+ ?line (catch file:delete(Fname)),
+ ok.
+
+t_delete_all_objects(doc) ->
+ ["Test ets:delete_all_objects/1"];
+t_delete_all_objects(suite) ->
+ [];
+t_delete_all_objects(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(t_delete_all_objects_do),
+ ?line verify_etsmem(EtsMem).
+
+t_delete_all_objects_do(Opts) ->
+ ?line T=ets:new(x,Opts),
+ ?line filltabint(T,4000),
+ ?line O=ets:first(T),
+ ?line ets:next(T,O),
+ ?line ets:safe_fixtable(T,true),
+ ?line true = ets:delete_all_objects(T),
+ ?line '$end_of_table' = ets:next(T,O),
+ ?line 0 = ets:info(T,size),
+ ?line 4000 = ets:info(T,kept_objects),
+ ?line ets:safe_fixtable(T,false),
+ ?line 0 = ets:info(T,size),
+ ?line 0 = ets:info(T,kept_objects),
+ ?line filltabint(T,4000),
+ ?line 4000 = ets:info(T,size),
+ ?line true = ets:delete_all_objects(T),
+ ?line 0 = ets:info(T,size),
+ ?line ets:delete(T).
+
+
+t_delete_object(doc) ->
+ ["Test ets:delete_object/2"];
+t_delete_object(suite) ->
+ [];
+t_delete_object(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(t_delete_object_do),
+ ?line verify_etsmem(EtsMem).
+
+t_delete_object_do(Opts) ->
+ ?line T = ets:new(x,Opts),
+ ?line filltabint(T,4000),
+ ?line del_one_by_one_set(T,1,4001),
+ ?line filltabint(T,4000),
+ ?line del_one_by_one_set(T,4000,0),
+ ?line filltabint(T,4000),
+ ?line First = ets:first(T),
+ ?line Next = ets:next(T,First),
+ ?line ets:safe_fixtable(T,true),
+ ?line ets:delete_object(T,{First, integer_to_list(First)}),
+ ?line Next = ets:next(T,First),
+ ?line 3999 = ets:info(T,size),
+ ?line 1 = ets:info(T,kept_objects),
+ ?line ets:safe_fixtable(T,false),
+ ?line 3999 = ets:info(T,size),
+ ?line 0 = ets:info(T,kept_objects),
+ ?line ets:delete(T),
+ ?line T1 = ets:new(x,[ordered_set | Opts]),
+ ?line filltabint(T1,4000),
+ ?line del_one_by_one_set(T1,1,4001),
+ ?line filltabint(T1,4000),
+ ?line del_one_by_one_set(T1,4000,0),
+ ?line ets:delete(T1),
+ ?line T2 = ets:new(x,[bag | Opts]),
+ ?line filltabint2(T2,4000),
+ ?line del_one_by_one_bag(T2,1,4001),
+ ?line filltabint2(T2,4000),
+ ?line del_one_by_one_bag(T2,4000,0),
+ ?line ets:delete(T2),
+ ?line T3 = ets:new(x,[duplicate_bag | Opts]),
+ ?line filltabint3(T3,4000),
+ ?line del_one_by_one_dbag_1(T3,1,4001),
+ ?line filltabint3(T3,4000),
+ ?line del_one_by_one_dbag_1(T3,4000,0),
+ ?line filltabint(T3,4000),
+ ?line filltabint3(T3,4000),
+ ?line del_one_by_one_dbag_2(T3,1,4001),
+ ?line filltabint(T3,4000),
+ ?line filltabint3(T3,4000),
+ ?line del_one_by_one_dbag_2(T3,4000,0),
+
+ ?line filltabint2(T3,4000),
+ ?line filltabint(T3,4000),
+ ?line del_one_by_one_dbag_3(T3,4000,0),
+ ?line ets:delete(T3),
+ ok.
+
+make_init_fun(N) when N > 4000->
+ fun(read) ->
+ end_of_input;
+ (close) ->
+ exit(close_not_expected)
+ end;
+make_init_fun(N) ->
+ fun(read) ->
+ case N rem 2 of
+ 0 ->
+ {[{N, integer_to_list(N)}, {N, integer_to_list(N)}],
+ make_init_fun(N + 1)};
+ 1 ->
+ {[], make_init_fun(N + 1)}
+ end;
+ (close) ->
+ exit(close_not_expected)
+ end.
+
+t_init_table(doc) ->
+ ["Test ets:init_table/2"];
+t_init_table(suite) ->
+ [];
+t_init_table(Config) when is_list(Config)->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(t_init_table_do),
+ ?line verify_etsmem(EtsMem).
+
+t_init_table_do(Opts) ->
+ ?line T = ets:new(x,[duplicate_bag | Opts]),
+ ?line filltabint(T,4000),
+ ?line ets:init_table(T, make_init_fun(1)),
+ ?line del_one_by_one_dbag_1(T,4000,0),
+ ?line ets:delete(T),
+ ok.
+
+do_fill_dbag_using_lists(T,0) ->
+ T;
+do_fill_dbag_using_lists(T,N) ->
+ ets:insert(T,[{N,integer_to_list(N)},
+ {N + N rem 2,integer_to_list(N + N rem 2)}]),
+ do_fill_dbag_using_lists(T,N - 1).
+
+
+t_insert_new(doc) ->
+ ["Test the insert_new function"];
+t_insert_new(suite) ->
+ [];
+t_insert_new(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line L = fill_sets_int(1000) ++ fill_sets_int(1000,[{write_concurrency,true}]),
+ lists:foreach(fun(Tab) ->
+ ?line false = ets:insert_new(Tab,{2,"2"}),
+ ?line true = ets:insert_new(Tab,{2002,"2002"}),
+ ?line false = ets:insert_new(Tab,{2002,"2002"}),
+ ?line true = ets:insert(Tab,{2002,"2002"}),
+ ?line false = ets:insert_new(Tab,[{2002,"2002"}]),
+ ?line false = ets:insert_new(Tab,[{2002,"2002"},
+ {2003,"2003"}]),
+ ?line false = ets:insert_new(Tab,[{2001,"2001"},
+ {2002,"2002"},
+ {2003,"2003"}]),
+ ?line false = ets:insert_new(Tab,[{2001,"2001"},
+ {2002,"2002"}]),
+ ?line true = ets:insert_new(Tab,[{2001,"2001"},
+ {2003,"2003"}]),
+ ?line false = ets:insert_new(Tab,{2001,"2001"}),
+ ?line false = ets:insert_new(Tab,{2002,"2002"}),
+ ?line false = ets:insert_new(Tab,{2003,"2003"}),
+ ?line true = ets:insert_new(Tab,{2004,"2004"}),
+ ?line true = ets:insert_new(Tab,{2000,"2000"}),
+ ?line true = ets:insert_new(Tab,[{2005,"2005"},
+ {2006,"2006"},
+ {2007,"2007"}]),
+ ?line Num =
+ case ets:info(Tab,type) of
+ bag ->
+ ?line true =
+ ets:insert(Tab,{2004,"2004-2"}),
+ ?line false =
+ ets:insert_new(Tab,{2004,"2004-3"}),
+ 1009;
+ duplicate_bag ->
+ ?line true =
+ ets:insert(Tab,{2004,"2004"}),
+ ?line false =
+ ets:insert_new(Tab,{2004,"2004"}),
+ 1010;
+ _ ->
+ 1008
+ end,
+ ?line Num = ets:info(Tab,size),
+ ?line List = ets:tab2list(Tab),
+ ?line ets:delete_all_objects(Tab),
+ ?line true = ets:insert_new(Tab,List),
+ ?line false = ets:insert_new(Tab,List),
+ ?line ets:delete(Tab)
+ end,
+ L),
+ ?line verify_etsmem(EtsMem).
+
+t_insert_list(doc) ->
+ ["Test ets:insert/2 with list of objects."];
+t_insert_list(suite) ->
+ [];
+t_insert_list(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(t_insert_list_do),
+ ?line verify_etsmem(EtsMem).
+
+t_insert_list_do(Opts) ->
+ ?line T = ets:new(x,[duplicate_bag | Opts]),
+ ?line do_fill_dbag_using_lists(T,4000),
+ ?line del_one_by_one_dbag_2(T,4000,0),
+ ?line ets:delete(T).
+
+
+t_test_ms(doc) ->
+ ["Test interface of ets:test_ms/2"];
+t_test_ms(suite) ->
+ [];
+t_test_ms(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line {ok,[a,b]} = ets:test_ms({a,b},
+ [{{'$1','$2'},[{'<','$1','$2'}],['$$']}]),
+ ?line {ok,false} = ets:test_ms({a,b},
+ [{{'$1','$2'},[{'>','$1','$2'}],['$$']}]),
+ ?line {error,[{error,String}]} = ets:test_ms({a,b},
+ [{{'$1','$2'},
+ [{'flurp','$1','$2'}],
+ ['$$']}]),
+ ?line true = (if is_list(String) -> true; true -> false end),
+ ?line verify_etsmem(EtsMem).
+
+t_select_delete(doc) ->
+ ["Test the ets:select_delete/2 and ets:select_count/2 BIF's"];
+t_select_delete(suite) ->
+ [];
+t_select_delete(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Tables = fill_sets_int(10000) ++ fill_sets_int(10000,[{write_concurrency,true}]),
+ lists:foreach
+ (fun(Table) ->
+ ?line 4000 = ets:select_count(Table,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ [true]}]),
+ ?line 4000 = ets:select_delete(Table,[{{'$1', '_'},
+ [{'>',
+ {'rem',
+ '$1', 5},
+ 2}],
+ [true]}]),
+ ?line check(Table,
+ fun({N,_}) when (N rem 5) =< 2 ->
+ true;
+ (_) ->
+ false
+ end,
+ 6000)
+
+ end,
+ Tables),
+ lists:foreach
+ (fun(Table) ->
+ ?line ets:select_delete(Table,[{'_',[],[true]}]),
+ ?line xfilltabint(Table,4000),
+ ?line successive_delete(Table,1,4001,bound),
+ ?line 0 = ets:info(Table,size),
+ ?line xfilltabint(Table,4000),
+ ?line successive_delete(Table,4000,0, bound),
+ ?line 0 = ets:info(Table,size),
+ ?line xfilltabint(Table,4000),
+ ?line successive_delete(Table,1,4001,unbound),
+ ?line 0 = ets:info(Table,size),
+ ?line xfilltabint(Table,4000),
+ ?line successive_delete(Table,4000,0, unbound),
+ ?line 0 = ets:info(Table,size)
+
+ end,
+ Tables),
+ lists:foreach
+ (fun(Table) ->
+ F = case ets:info(Table,type) of
+ X when X == bag; X == duplicate_bag ->
+ 2;
+ _ ->
+ 1
+ end,
+ ?line xfilltabstr(Table, 4000),
+ ?line 1000 = ets:select_count(Table,
+ [{{[$3 | '$1'], '_'},
+ [{'==',
+ {'length', '$1'},
+ 3}],[true]}]) div F,
+ ?line 1000 = ets:select_delete(Table,
+ [{{[$3 | '$1'], '_'},
+ [{'==',
+ {'length', '$1'},
+ 3}],[true]}]) div F,
+ ?line check(Table, fun({[3,_,_,_],_}) -> false;
+ (_) -> true
+ end, 3000*F),
+ ?line 8 = ets:select_count(Table,
+ [{{"7",'_'},[],[false]},
+ {{['_'], '_'},
+ [],[true]}]) div F,
+ ?line 8 = ets:select_delete(Table,
+ [{{"7",'_'},[],[false]},
+ {{['_'], '_'},
+ [],[true]}]) div F,
+ ?line check(Table, fun({"7",_}) -> true;
+ ({[_],_}) -> false;
+ (_) -> true
+ end, 2992*F),
+ ?line xfilltabstr(Table, 4000),
+ %% This happens to be interesting for other select types too
+ ?line 200 = length(ets:select(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}])) div F,
+ ?line 200 = ets:select_count(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}]) div F,
+ ?line 200 = length(element(1,ets:select(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}],
+ 1000))) div F,
+ ?line 200 = length(
+ ets:select_reverse(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}])) div F,
+ ?line 200 = length(
+ element(1,
+ ets:select_reverse
+ (Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}],
+ 1000))) div F,
+ ?line 200 = ets:select_delete(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}]) div F,
+ ?line 0 = ets:select_count(Table,
+ [{{[$3,'_','_'],'_'},
+ [],[true]},
+ {{[$1,'_','_'],'_'},
+ [],[true]}]) div F,
+ ?line check(Table, fun({[$3,_,_],_}) -> false;
+ ({[$1,_,_],_}) -> false;
+ (_) -> true
+ end, 3800*F)
+ end,
+ Tables),
+ lists:foreach(fun(Tab) -> ets:delete(Tab) end,Tables),
+ ?line verify_etsmem(EtsMem).
+
+partly_bound(doc) ->
+ ["Test that partly bound keys gives faster matches"];
+partly_bound(suite) ->
+ [];
+partly_bound(Config) when is_list(Config) ->
+ case os:type() of
+ {win32,_} ->
+ {skip,"Inaccurate measurements on Windows"};
+ _ ->
+ ?line EtsMem = etsmem(),
+ ?line dont_make_worse(),
+ ?line make_better(),
+ ?line verify_etsmem(EtsMem)
+ end.
+
+dont_make_worse() ->
+ seventyfive_percent_success({?MODULE,dont_make_worse_sub,[]},0,0,10).
+
+dont_make_worse_sub() ->
+ ?line T = build_table([a,b],[a,b],15000),
+ ?line T1 = time_match_object(T,{'_',a,a,1500}, [{{a,a,1500},a,a,1500}]),
+ ?line T2 = time_match_object(T,{{a,a,'_'},a,a,1500},
+ [{{a,a,1500},a,a,1500}]),
+ ?line ets:delete(T),
+ ?line true = (T1 > T2),
+ ok.
+
+make_better() ->
+ fifty_percent_success({?MODULE,make_better_sub2,[]},0,0,10),
+ fifty_percent_success({?MODULE,make_better_sub1,[]},0,0,10).
+make_better_sub1() ->
+ ?line T = build_table2([a,b],[a,b],15000),
+ ?line T1 = time_match_object(T,{'_',1500,a,a}, [{{1500,a,a},1500,a,a}]),
+ ?line T2 = time_match_object(T,{{1500,a,'_'},1500,a,a},
+ [{{1500,a,a},1500,a,a}]),
+ ?line ets:delete(T),
+ ?line io:format("~p>~p~n",[(T1 / 100),T2]),
+ ?line true = ((T1 / 100) > T2), % More marginal than needed.
+ ok.
+
+make_better_sub2() ->
+ ?line T = build_table2([a,b],[a,b],15000),
+ ?line T1 = time_match(T,{'$1',1500,a,a}),
+ ?line T2 = time_match(T,{{1500,a,'$1'},1500,a,a}),
+ ?line ets:delete(T),
+ ?line io:format("~p>~p~n",[(T1 / 100),T2]),
+ ?line true = ((T1 / 100) > T2), % More marginal than needed.
+ ok.
+
+
+match_heavy(doc) ->
+ ["Heavy random matching, comparing set with ordered_set."];
+match_heavy(suite) ->
+ [];
+match_heavy(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ DataDir = ?config(data_dir, Config),
+ %% Easier to have in process dictionary when manually
+ %% running the test function.
+ put(where_to_read,DataDir),
+ put(where_to_write,PrivDir),
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ NewDog=test_server:timetrap(test_server:seconds(1000)),
+ NewConfig = [{watchdog, NewDog} | lists:keydelete(watchdog,1,Config)],
+ random_test(),
+ drop_match(),
+ NewConfig.
+
+%%% Extra safety for the very low probability that this is not
+%%% caught by the random test (Statistically impossible???)
+drop_match() ->
+ ?line EtsMem = etsmem(),
+ ?line T = build_table([a,b],[a],1500),
+ ?line [{{a,a,1},a,a,1},{{b,a,1},b,a,1}] =
+ ets:match_object(T, {'_','_','_',1}),
+ ?line true = ets:delete(T),
+ ?line verify_etsmem(EtsMem).
+
+
+
+ets_match(Tab,Expr) ->
+ case random:uniform(2) of
+ 1 ->
+ ets:match(Tab,Expr);
+ _ ->
+ match_chunked(Tab,Expr)
+ end.
+
+match_chunked(Tab,Expr) ->
+ match_chunked_collect(ets:match(Tab,Expr,
+ random:uniform(1999) + 1)).
+match_chunked_collect('$end_of_table') ->
+ [];
+match_chunked_collect({Results, Continuation}) ->
+ Results ++ match_chunked_collect(ets:match(Continuation)).
+
+ets_match_object(Tab,Expr) ->
+ case random:uniform(2) of
+ 1 ->
+ ets:match_object(Tab,Expr);
+ _ ->
+ match_object_chunked(Tab,Expr)
+ end.
+
+match_object_chunked(Tab,Expr) ->
+ match_object_chunked_collect(ets:match_object(Tab,Expr,
+ random:uniform(1999) + 1)).
+match_object_chunked_collect('$end_of_table') ->
+ [];
+match_object_chunked_collect({Results, Continuation}) ->
+ Results ++ match_object_chunked_collect(ets:match_object(Continuation)).
+
+
+
+random_test() ->
+ ?line ReadDir = get(where_to_read),
+ ?line WriteDir = get(where_to_write),
+ ?line (catch file:make_dir(WriteDir)),
+ ?line Seed = case file:consult(filename:join([ReadDir,
+ "preset_random_seed.txt"])) of
+ {ok,[X]} ->
+ X;
+ _ ->
+ {A,B,C} = erlang:now(),
+ random:seed(A,B,C),
+ get(random_seed)
+ end,
+ put(random_seed,Seed),
+ ?line {ok, F} = file:open(filename:join([WriteDir,
+ "last_random_seed.txt"]),
+ [write]),
+ io:format(F,"~p. ~n",[Seed]),
+ file:close(F),
+ io:format("Random seed ~p written to ~s, copy to ~s to rerun with "
+ "same seed.",[Seed,
+ filename:join([WriteDir, "last_random_seed.txt"]),
+ filename:join([ReadDir,
+ "preset_random_seed.txt"])]),
+ do_random_test().
+
+do_random_test() ->
+ ?line EtsMem = etsmem(),
+ ?line OrdSet = ets:new(xxx,[ordered_set]),
+ ?line Set = ets:new(xxx,[]),
+ ?line do_n_times(fun() ->
+ ?line Key = create_random_string(25),
+ ?line Value = create_random_tuple(25),
+ ?line ets:insert(OrdSet,{Key,Value}),
+ ?line ets:insert(Set,{Key,Value})
+ end, 5000),
+ ?line io:format("~nData inserted~n"),
+ ?line do_n_times(fun() ->
+ ?line I = random:uniform(25),
+ ?line Key = create_random_string(I) ++ '_',
+ ?line L1 = ets_match_object(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end,
+ 2000),
+ ?line io:format("~nData matched~n"),
+ ?line ets:match_delete(OrdSet,'_'),
+ ?line ets:match_delete(Set,'_'),
+ ?line do_n_times(fun() ->
+ ?line Value = create_random_string(25),
+ ?line Key = create_random_tuple(25),
+ ?line ets:insert(OrdSet,{Key,Value}),
+ ?line ets:insert(Set,{Key,Value})
+ end, 2000),
+ ?line io:format("~nData inserted~n"),
+ (fun() ->
+ ?line Key = list_to_tuple(lists:duplicate(25,'_')),
+ ?line L1 = ets_match_object(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
+ ?line 2000 = length(L1),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end)(),
+ (fun() ->
+ ?line Key = {'$1','$2','$3','$4',
+ '$5','$6','$7','$8',
+ '$9','$10','$11','$12',
+ '$13','$14','$15','$16',
+ '$17','$18','$19','$20',
+ '$21','$22','$23','$24',
+ '$25'},
+ ?line L1 = ets_match_object(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
+ ?line 2000 = length(L1),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end)(),
+ (fun() ->
+ ?line Key = {'$1','$2','$3','$4',
+ '$5','$6','$7','$8',
+ '$9','$10','$11','$12',
+ '$13','$14','$15','$16',
+ '$17','$18','$19','$20',
+ '$21','$22','$23','$24',
+ '$25'},
+ ?line L1 = ets_match(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match(Set,{Key,'_'})),
+ ?line 2000 = length(L1),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end)(),
+ ?line ets:match_delete(OrdSet,'_'),
+ ?line ets:match_delete(Set,'_'),
+ ?line do_n_times(fun() ->
+ ?line Value = create_random_string(25),
+ ?line Key = create_random_tuple(25),
+ ?line ets:insert(OrdSet,{Key,Value}),
+ ?line ets:insert(Set,{Key,Value})
+ end, 2000),
+ ?line io:format("~nData inserted~n"),
+ do_n_times(fun() ->
+ ?line Key = create_partly_bound_tuple(25),
+ ?line L1 = ets_match_object(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end,
+ 2000),
+ ?line do_n_times(fun() ->
+ ?line Key = create_partly_bound_tuple2(25),
+ ?line L1 = ets_match_object(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end,
+ 2000),
+ do_n_times(fun() ->
+ ?line Key = create_partly_bound_tuple2(25),
+ ?line L1 = ets_match(OrdSet,{Key,'_'}),
+ ?line L2 = lists:sort(ets_match(Set,{Key,'_'})),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p~n",
+ [L1,L2]),
+ ?line exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end,
+ 2000),
+ io:format("~nData matched~n"),
+ ets:match_delete(OrdSet,'_'),
+ ets:match_delete(Set,'_'),
+ do_n_times(fun() ->
+ do_n_times(fun() ->
+ ?line Value =
+ create_random_string(25),
+ ?line Key = create_random_tuple(25),
+ ?line ets:insert(OrdSet,{Key,Value}),
+ ?line ets:insert(Set,{Key,Value})
+ end, 500),
+ io:format("~nData inserted~n"),
+ do_n_times(fun() ->
+ ?line Key =
+ create_partly_bound_tuple(25),
+ ets:match_delete(OrdSet,{Key,'_'}),
+ ets:match_delete(Set,{Key,'_'}),
+ L1 = ets:info(OrdSet,size),
+ L2 = ets:info(Set,size),
+ [] = ets_match_object(OrdSet,
+ {Key,'_'}),
+ case L1 == L2 of
+ false ->
+ io:format("~p != ~p "
+ "(deleted ~p)~n",
+ [L1,L2,Key]),
+ exit({not_eq, L1, L2,
+ {deleted,Key}});
+ true ->
+ ok
+ end
+ end,
+ 50),
+ io:format("~nData deleted~n")
+ end,
+ 10),
+ ets:delete(OrdSet),
+ ets:delete(Set),
+ ?line verify_etsmem(EtsMem).
+
+update_element(doc) ->
+ ["test various variants of update_element"];
+update_element(suite) ->
+ [];
+update_element(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(update_element_opts),
+ ?line verify_etsmem(EtsMem).
+
+update_element_opts(Opts) ->
+ TupleCases = [{{key,val}, 1 ,2},
+ {{val,key}, 2, 1},
+ {{key,val}, 1 ,[2]},
+ {{key,val,val}, 1, [2,3]},
+ {{val,key,val,val}, 2, [3,4,1]},
+ {{val,val,key,val}, 3, [1,4,1,2]}, % update pos1 twice
+ {{val,val,val,key}, 4, [2,1,2,3]}],% update pos2 twice
+
+ lists:foreach(fun({Tuple,KeyPos,UpdPos}) -> update_element_opts(Tuple,KeyPos,UpdPos,Opts) end,
+ TupleCases),
+
+ update_element_neg(Opts).
+
+
+
+update_element_opts(Tuple,KeyPos,UpdPos,Opts) ->
+ Set = ets:new(set,[{keypos,KeyPos} | Opts]),
+ OrdSet = ets:new(ordered_set,[ordered_set,{keypos,KeyPos} | Opts]),
+ update_element(Set,Tuple,KeyPos,UpdPos),
+ update_element(OrdSet,Tuple,KeyPos,UpdPos),
+ true = ets:delete(Set),
+ true = ets:delete(OrdSet),
+ ok.
+
+update_element(T,Tuple,KeyPos,UpdPos) ->
+ KeyList = [Key || Key <- lists:seq(1,100)],
+ lists:foreach(fun(Key) ->
+ TupleWithKey = setelement(KeyPos,Tuple,Key),
+ update_element_do(T,TupleWithKey,Key,UpdPos)
+ end,
+ KeyList).
+
+update_element_do(Tab,Tuple,Key,UpdPos) ->
+
+ % Strategy: Step around in Values array and call ets:update_element for the values.
+ % Take Length number of steps of size 1, then of size 2, ..., Length-1.
+ % This will try all combinations of {fromValue,toValue}
+ %
+ % IMPORTANT: size(Values) must be a prime number for this to work!!!
+ Big32 = 16#12345678,
+ Big64 = 16#123456789abcdef0,
+ Values = { 623, -27, 0, Big32, -Big32, Big64, -Big64, Big32*Big32,
+ -Big32*Big32, Big32*Big64, -Big32*Big64, Big64*Big64, -Big64*Big64,
+ "A", "Sverker", [], {12,-132}, {},
+ <<45,232,0,12,133>>, <<234,12,23>>, list_to_binary(lists:seq(1,100)),
+ (fun(X) -> X*Big32 end),
+ make_ref(), make_ref(), self(), ok, update_element, 28, 29 },
+ Length = size(Values),
+
+ PosValArgF = fun(ToIx, ResList, [Pos | PosTail], Rand, MeF) ->
+ NextIx = (ToIx+Rand) rem Length,
+ MeF(NextIx, [{Pos,element(ToIx+1,Values)} | ResList], PosTail, Rand, MeF);
+
+ (_ToIx, ResList, [], _Rand, _MeF) ->
+ ResList;
+
+ (ToIx, [], Pos, _Rand, _MeF) ->
+ {Pos, element(ToIx+1,Values)} % single {pos,value} arg
+ end,
+
+ NewTupleF = fun({Pos,Val}, Tpl, _MeF) ->
+ setelement(Pos, Tpl, Val);
+ ([{Pos,Val} | Tail], Tpl, MeF) ->
+ MeF(Tail,setelement(Pos, Tpl, Val),MeF);
+ ([], Tpl, _MeF) ->
+ Tpl
+ end,
+
+ UpdateF = fun(ToIx,Rand) ->
+ PosValArg = PosValArgF(ToIx,[],UpdPos,Rand,PosValArgF),
+ %%io:format("update_element(~p)~n",[PosValArg]),
+ ArgHash = erlang:phash2({Tab,Key,PosValArg}),
+ ?line true = ets:update_element(Tab, Key, PosValArg),
+ ?line ArgHash = erlang:phash2({Tab,Key,PosValArg}),
+ NewTuple = NewTupleF(PosValArg,Tuple,NewTupleF),
+ ?line [NewTuple] = ets:lookup(Tab,Key)
+ end,
+
+ LoopF = fun(_FromIx, Incr, _Times, Checksum, _MeF) when Incr >= Length ->
+ Checksum; % done
+
+ (FromIx, Incr, 0, Checksum, MeF) ->
+ MeF(FromIx, Incr+1, Length, Checksum, MeF);
+
+ (FromIx, Incr, Times, Checksum, MeF) ->
+ ToIx = (FromIx + Incr) rem Length,
+ UpdateF(ToIx,Checksum),
+ if
+ Incr =:= 0 -> UpdateF(ToIx,Checksum); % extra update to same value
+ true -> true
+ end,
+ MeF(ToIx, Incr, Times-1, Checksum+ToIx+1, MeF)
+ end,
+
+ FirstTuple = Tuple,
+ ?line true = ets:insert(Tab,FirstTuple),
+ ?line [FirstTuple] = ets:lookup(Tab,Key),
+
+ Checksum = LoopF(0, 1, Length, 0, LoopF),
+ ?line Checksum = (Length-1)*Length*(Length+1) div 2, % if Length is a prime
+ ok.
+
+update_element_neg(Opts) ->
+ Set = ets:new(set,Opts),
+ OrdSet = ets:new(ordered_set,[ordered_set | Opts]),
+ update_element_neg_do(Set),
+ update_element_neg_do(OrdSet),
+ ets:delete(Set),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_element(Set,key,{2,1})),
+ ets:delete(OrdSet),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_element(OrdSet,key,{2,1})),
+
+ ?line Bag = ets:new(bag,[bag | Opts]),
+ ?line DBag = ets:new(duplicate_bag,[duplicate_bag | Opts]),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_element(Bag,key,{2,1})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_element(DBag,key,{2,1})),
+ true = ets:delete(Bag),
+ true = ets:delete(DBag),
+ ok.
+
+
+update_element_neg_do(T) ->
+ Object = {key, 0, "Hej"},
+ ?line true = ets:insert(T,Object),
+
+ UpdateF = fun(Arg3) ->
+ ArgHash = erlang:phash2({T,key,Arg3}),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_element(T,key,Arg3)),
+ ?line ArgHash = erlang:phash2({T,key,Arg3}),
+ ?line [Object] = ets:lookup(T,key)
+ end,
+
+ %% List of invalid {Pos,Value} tuples
+ InvList = [false, {2}, {2,1,false}, {false,1}, {0,1}, {1,1}, {-1,1}, {4,1}],
+
+ lists:foreach(UpdateF, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([{2,1},InvTpl]) end, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([InvTpl,{2,1}]) end, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([{2,1},{3,"Hello"},InvTpl]) end, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([{3,"Hello"},{2,1},InvTpl]) end, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([{2,1},InvTpl,{3,"Hello"}]) end, InvList),
+ lists:foreach(fun(InvTpl) -> UpdateF([InvTpl,{3,"Hello"},{2,1}]) end, InvList),
+ UpdateF([{2,1} | {3,1}]),
+ lists:foreach(fun(InvTpl) -> UpdateF([{2,1} | InvTpl]) end, InvList),
+
+ ?line true = ets:update_element(T,key,[]),
+ ?line false = ets:update_element(T,false,[]),
+ ?line false = ets:update_element(T,false,{2,1}),
+ ?line ets:delete(T,key),
+ ?line false = ets:update_element(T,key,{2,1}),
+ ok.
+
+
+update_counter(doc) ->
+ ["test various variants of update_counter"];
+update_counter(suite) ->
+ [];
+update_counter(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(update_counter_do),
+ ?line verify_etsmem(EtsMem).
+
+update_counter_do(Opts) ->
+ Set = ets:new(set,Opts),
+ OrdSet = ets:new(ordered_set,[ordered_set | Opts]),
+ update_counter_for(Set),
+ update_counter_for(OrdSet),
+ ets:delete(Set),
+ ets:delete(OrdSet),
+ update_counter_neg(Opts).
+
+update_counter_for(T) ->
+ ?line ets:insert(T,{a,1,1}),
+ ?line 101 = ets:update_counter(T,a,100),
+ ?line [{a,101,1}] = ets:lookup(T,a),
+ ?line 101 = ets:update_counter(T,a,{3,100}),
+ ?line [{a,101,101}] = ets:lookup(T,a),
+
+
+ LooperF = fun(Obj, 0, _, _) ->
+ Obj;
+
+ (Obj, Times, Arg3, Myself) ->
+ ?line {NewObj, Ret} = uc_mimic(Obj,Arg3),
+ ArgHash = erlang:phash2({T,a,Arg3}),
+ ?line Ret = ets:update_counter(T,a,Arg3),
+ ?line ArgHash = erlang:phash2({T,a,Arg3}),
+ %%io:format("NewObj=~p~n ",[NewObj]),
+ ?line [NewObj] = ets:lookup(T,a),
+ Myself(NewObj,Times-1,Arg3,Myself)
+ end,
+
+ LoopF = fun(Obj, Times, Arg3) ->
+ %%io:format("Loop start:\nObj = ~p\nArg3=~p\n",[Obj,Arg3]),
+ LooperF(Obj,Times,Arg3,LooperF)
+ end,
+
+ SmallMax32 = (1 bsl 27) - 1,
+ SmallMax64 = (1 bsl (27+32)) - 1,
+ Big1Max32 = (1 bsl 32) - 1,
+ Big1Max64 = (1 bsl 64) - 1,
+
+ Steps = 100,
+ Obj0 = {a,0,0,0,0},
+ ?line ets:insert(T,Obj0),
+ ?line Obj1 = LoopF(Obj0, Steps, {2,(SmallMax32 div Steps)*2}),
+ ?line Obj2 = LoopF(Obj1, Steps, {3,(SmallMax64 div Steps)*2}),
+ ?line Obj3 = LoopF(Obj2, Steps, {4,(Big1Max32 div Steps)*2}),
+ ?line Obj4 = LoopF(Obj3, Steps, {5,(Big1Max64 div Steps)*2}),
+
+ ?line Obj5 = LoopF(Obj4, Steps, {2,-(SmallMax32 div Steps)*4}),
+ ?line Obj6 = LoopF(Obj5, Steps, {3,-(SmallMax64 div Steps)*4}),
+ ?line Obj7 = LoopF(Obj6, Steps, {4,-(Big1Max32 div Steps)*4}),
+ ?line Obj8 = LoopF(Obj7, Steps, {5,-(Big1Max64 div Steps)*4}),
+
+ ?line Obj9 = LoopF(Obj8, Steps, {2,(SmallMax32 div Steps)*2}),
+ ?line ObjA = LoopF(Obj9, Steps, {3,(SmallMax64 div Steps)*2}),
+ ?line ObjB = LoopF(ObjA, Steps, {4,(Big1Max32 div Steps)*2}),
+ ?line Obj0 = LoopF(ObjB, Steps, {5,(Big1Max64 div Steps)*2}),
+
+ %% back at zero, same trip again with lists
+
+ ?line Obj4 = LoopF(Obj0,Steps,[{2, (SmallMax32 div Steps)*2},
+ {3, (SmallMax64 div Steps)*2},
+ {4, (Big1Max32 div Steps)*2},
+ {5, (Big1Max64 div Steps)*2}]),
+
+ ?line Obj8 = LoopF(Obj4,Steps,[{4, -(Big1Max32 div Steps)*4},
+ {2, -(SmallMax32 div Steps)*4},
+ {5, -(Big1Max64 div Steps)*4},
+ {3, -(SmallMax64 div Steps)*4}]),
+
+ ?line Obj0 = LoopF(Obj8,Steps,[{5, (Big1Max64 div Steps)*2},
+ {2, (SmallMax32 div Steps)*2},
+ {4, (Big1Max32 div Steps)*2},
+ {3, (SmallMax64 div Steps)*2}]),
+
+ %% make them shift size at the same time
+ ?line ObjC = LoopF(Obj0,Steps,[{5, (Big1Max64 div Steps)*2},
+ {3, (Big1Max64 div Steps)*2 + 1},
+ {2, -(Big1Max64 div Steps)*2},
+ {4, -(Big1Max64 div Steps)*2 + 1}]),
+
+ %% update twice in same list
+ ?line ObjD = LoopF(ObjC,Steps,[{5, -(Big1Max64 div Steps) + 1},
+ {3, -(Big1Max64 div Steps)*2 - 1},
+ {5, -(Big1Max64 div Steps) - 1},
+ {4, (Big1Max64 div Steps)*2 - 1}]),
+
+ ?line Obj0 = LoopF(ObjD,Steps,[{2, (Big1Max64 div Steps) - 1},
+ {4, Big1Max64*2},
+ {2, (Big1Max64 div Steps) + 1},
+ {4, -Big1Max64*2}]),
+
+ %% warping with list
+ ?line ObjE = LoopF(Obj0,1000,
+ [{3,SmallMax32*4 div 5,SmallMax32*2,-SmallMax32*2},
+ {5,-SmallMax64*4 div 7,-SmallMax64*2,SmallMax64*2},
+ {4,-Big1Max32*4 div 11,-Big1Max32*2,Big1Max32*2},
+ {2,Big1Max64*4 div 13,Big1Max64*2,-Big1Max64*2}]),
+
+ %% warping without list
+ ?line ObjF = LoopF(ObjE,1000,{3,SmallMax32*4 div 5,SmallMax32*2,-SmallMax32*2}),
+ ?line ObjG = LoopF(ObjF,1000,{5,-SmallMax64*4 div 7,-SmallMax64*2,SmallMax64*2}),
+ ?line ObjH = LoopF(ObjG,1000,{4,-Big1Max32*4 div 11,-Big1Max32*2,Big1Max32*2}),
+ ?line ObjI = LoopF(ObjH,1000,{2,Big1Max64*4 div 13,Big1Max64*2,-Big1Max64*2}),
+
+ %% mixing it up
+ ?line LoopF(ObjI,1000,
+ [{3,SmallMax32*4 div 5,SmallMax32*2,-SmallMax32*2},
+ {5,-SmallMax64*4 div 3},
+ {3,-SmallMax32*4 div 11},
+ {5,0},
+ {4,1},
+ {5,-SmallMax64*4 div 7,-SmallMax64*2,SmallMax64*2},
+ {2,Big1Max64*4 div 13,Big1Max64*2,-Big1Max64*2}]),
+ ok.
+
+%% uc_mimic works kind of like the real ets:update_counter
+%% Obj = Tuple in ets
+%% Pits = {Pos,Incr} | {Pos,Incr,Thres,Warp}
+%% Returns {Updated tuple in ets, Return value from update_counter}
+uc_mimic(Obj, Pits) when is_tuple(Pits) ->
+ ?line Pos = element(1,Pits),
+ ?line NewObj = setelement(Pos, Obj, uc_adder(element(Pos,Obj),Pits)),
+ ?line {NewObj, element(Pos,NewObj)};
+
+uc_mimic(Obj, PitsList) when is_list(PitsList) ->
+ ?line {NewObj,ValList} = uc_mimic(Obj,PitsList,[]),
+ ?line {NewObj,lists:reverse(ValList)}.
+
+uc_mimic(Obj, [], Acc) ->
+ ?line {Obj,Acc};
+uc_mimic(Obj, [Pits|Tail], Acc) ->
+ ?line {NewObj,NewVal} = uc_mimic(Obj,Pits),
+ ?line uc_mimic(NewObj,Tail,[NewVal|Acc]).
+
+uc_adder(Init, {_Pos, Add}) ->
+ Init + Add;
+uc_adder(Init, {_Pos, Add, Thres, Warp}) ->
+ case Init + Add of
+ X when X > Thres, Add > 0 ->
+ Warp;
+ Y when Y < Thres, Add < 0 ->
+ Warp;
+ Z ->
+ Z
+ end.
+
+update_counter_neg(Opts) ->
+ Set = ets:new(set,Opts),
+ OrdSet = ets:new(ordered_set,[ordered_set | Opts]),
+ update_counter_neg_for(Set),
+ update_counter_neg_for(OrdSet),
+ ets:delete(Set),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(Set,key,1)),
+ ets:delete(OrdSet),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(OrdSet,key,1)),
+
+ ?line Bag = ets:new(bag,[bag | Opts]),
+ ?line DBag = ets:new(duplicate_bag,[duplicate_bag | Opts]),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(Bag,key,1)),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(DBag,key,1)),
+ true = ets:delete(Bag),
+ true = ets:delete(DBag),
+ ok.
+
+update_counter_neg_for(T) ->
+ Object = {key,0,false,1},
+ ?line true = ets:insert(T,Object),
+
+ UpdateF = fun(Arg3) ->
+ ArgHash = erlang:phash2({T,key,Arg3}),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(T,key,Arg3)),
+ ?line ArgHash = erlang:phash2({T,key,Arg3}),
+ ?line [Object] = ets:lookup(T,key)
+ end,
+
+ %% List of invalid arg3-tuples
+ InvList = [false, {2}, {2,false}, {false,1},
+ {0,1}, {-1,1}, % BUG < R12B-2
+ {1,1}, {3,1}, {5,1}, {2,1,100}, {2,1,100,0,false}, {2,1,false,0}, {2,1,0,false}],
+
+ lists:foreach(UpdateF, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([{2,1},Inv]) end, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([Inv,{2,1}]) end, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([{2,1},{4,-100},Inv]) end, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([{4,100,50,0},{2,1},Inv]) end, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([{2,1},Inv,{4,100,50,0}]) end, InvList),
+ lists:foreach(fun(Inv) -> UpdateF([Inv,{4,100,50,0},{2,1}]) end, InvList),
+ UpdateF([{2,1} | {4,1}]),
+ lists:foreach(fun(Inv) -> UpdateF([{2,1} | Inv]) end, InvList),
+
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(T,false,1)),
+ ?line ets:delete(T,key),
+ ?line {'EXIT',{badarg,_}} = (catch ets:update_counter(T,key,1)),
+ ok.
+
+
+evil_update_counter(Config) when is_list(Config) ->
+ %% The code server uses ets table. Pre-load modules that might not be
+ %% already loaded.
+ gb_sets:module_info(),
+ math:module_info(),
+ ordsets:module_info(),
+ random:module_info(),
+
+ repeat_for_opts(evil_update_counter_do).
+
+evil_update_counter_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line process_flag(trap_exit, true),
+ ?line Pids = [spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)],
+ ?line wait_for_all(gb_sets:from_list(Pids)),
+ ?line verify_etsmem(EtsMem),
+ ok.
+
+wait_for_all(Pids0) ->
+ case gb_sets:is_empty(Pids0) of
+ true ->
+ ok;
+ false ->
+ receive
+ {'EXIT',Pid,normal} ->
+ ?line Pids = gb_sets:delete(Pid, Pids0),
+ wait_for_all(Pids);
+ Other ->
+ io:format("unexpected: ~p\n", [Other]),
+ ?line ?t:fail()
+ end
+ end.
+
+evil_counter(I,Opts) ->
+ T = ets:new(a, Opts),
+ Start0 = case I rem 3 of
+ 0 -> 16#12345678;
+ 1 -> 16#12345678FFFFFFFF;
+ 2 -> 16#7777777777FFFFFFFF863648726743
+ end,
+ Start = Start0 + random:uniform(100000),
+ ets:insert(T, {dracula,Start}),
+ Iter = 90000,
+ End = Start + Iter,
+ End = evil_counter_1(Iter, T),
+ ets:delete(T).
+
+evil_counter_1(0, T) ->
+ [{dracula,Count}] = ets:lookup(T, dracula),
+ Count;
+evil_counter_1(Iter, T) ->
+ ets:update_counter(T, dracula, 1),
+ evil_counter_1(Iter-1, T).
+
+fixtable_next(doc) ->
+ ["Check that a first-next sequence always works on a fixed table"];
+fixtable_next(suite) ->
+ [];
+fixtable_next(Config) when is_list(Config) ->
+ repeat_for_opts(fixtable_next_do, [write_concurrency,all_types]).
+
+fixtable_next_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line do_fixtable_next(ets:new(set,[public | Opts])),
+ ?line verify_etsmem(EtsMem).
+
+do_fixtable_next(Tab) ->
+ ?line F = fun(X,T,FF) -> case X of
+ 0 -> true;
+ _ ->
+ ets:insert(T, {X,
+ integer_to_list(X),
+ X rem 10}),
+ FF(X-1,T,FF)
+ end
+ end,
+ ?line F(100,Tab,F),
+ ?line ets:safe_fixtable(Tab,true),
+ ?line First = ets:first(Tab),
+ ?line ets:delete(Tab, First),
+ ?line ets:next(Tab, First),
+ ?line ets:match_delete(Tab,{'_','_','_'}),
+ ?line '$end_of_table' = ets:next(Tab, First),
+ ?line true = ets:info(Tab, fixed),
+ ?line ets:safe_fixtable(Tab, false),
+ ?line false = ets:info(Tab, fixed),
+ ?line ets:delete(Tab).
+
+fixtable_insert(doc) ->
+ ["Check inserts of deleted keys in fixed bags"];
+fixtable_insert(suite) ->
+ [];
+fixtable_insert(Config) when is_list(Config) ->
+ Combos = [[Type,{write_concurrency,WC}] || Type<- [bag,duplicate_bag],
+ WC <- [false,true]],
+ lists:foreach(fun(Opts) -> fixtable_insert_do(Opts) end,
+ Combos),
+ ok.
+
+fixtable_insert_do(Opts) ->
+ io:format("Opts = ~p\n",[Opts]),
+ Ets = make_table(ets, Opts, [{a,1}, {a,2}, {b,1}, {b,2}]),
+ ets:safe_fixtable(Ets,true),
+ ets:match_delete(Ets,{b,1}),
+ First = ets:first(Ets),
+ ?line Next = case First of
+ a -> b;
+ b -> a
+ end,
+ ?line Next = ets:next(Ets,First),
+ ets:delete(Ets,Next),
+ ?line '$end_of_table' = ets:next(Ets,First),
+ ets:insert(Ets, {Next,1}),
+ ?line false = ets:insert_new(Ets, {Next,1}),
+ ?line Next = ets:next(Ets,First),
+ ?line '$end_of_table' = ets:next(Ets,Next),
+ ets:delete(Ets,Next),
+ '$end_of_table' = ets:next(Ets,First),
+ ets:insert(Ets, {Next,2}),
+ ?line false = ets:insert_new(Ets, {Next,1}),
+ Next = ets:next(Ets,First),
+ '$end_of_table' = ets:next(Ets,Next),
+ ets:delete(Ets,First),
+ ?line Next = ets:first(Ets),
+ ?line '$end_of_table' = ets:next(Ets,Next),
+ ets:delete(Ets,Next),
+ ?line '$end_of_table' = ets:next(Ets,First),
+ ?line true = ets:insert_new(Ets,{Next,1}),
+ ?line false = ets:insert_new(Ets,{Next,2}),
+ ?line Next = ets:next(Ets,First),
+ ets:delete_object(Ets,{Next,1}),
+ ?line '$end_of_table' = ets:next(Ets,First),
+ ?line true = ets:insert_new(Ets,{Next,2}),
+ ?line false = ets:insert_new(Ets,{Next,1}),
+ ?line Next = ets:next(Ets,First),
+ ets:delete(Ets,First),
+ ets:safe_fixtable(Ets,false),
+ {'EXIT',{badarg,_}} = (catch ets:next(Ets,First)),
+ ok.
+
+write_concurrency(doc) -> ["The 'write_concurrency' option"];
+write_concurrency(suite) -> [];
+write_concurrency(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ Yes1 = ets:new(foo,[public,{write_concurrency,true}]),
+ Yes2 = ets:new(foo,[protected,{write_concurrency,true}]),
+ No1 = ets:new(foo,[private,{write_concurrency,true}]),
+
+ Yes3 = ets:new(foo,[bag,public,{write_concurrency,true}]),
+ Yes4 = ets:new(foo,[bag,protected,{write_concurrency,true}]),
+ No2 = ets:new(foo,[bag,private,{write_concurrency,true}]),
+
+ Yes5 = ets:new(foo,[duplicate_bag,public,{write_concurrency,true}]),
+ Yes6 = ets:new(foo,[duplicate_bag,protected,{write_concurrency,true}]),
+ No3 = ets:new(foo,[duplicate_bag,private,{write_concurrency,true}]),
+
+ No4 = ets:new(foo,[ordered_set,public,{write_concurrency,true}]),
+ No5 = ets:new(foo,[ordered_set,protected,{write_concurrency,true}]),
+ No6 = ets:new(foo,[ordered_set,private,{write_concurrency,true}]),
+
+ No7 = ets:new(foo,[public,{write_concurrency,false}]),
+ No8 = ets:new(foo,[protected,{write_concurrency,false}]),
+
+ ?line YesMem = ets:info(Yes1,memory),
+ ?line NoHashMem = ets:info(No1,memory),
+ ?line NoTreeMem = ets:info(No4,memory),
+ io:format("YesMem=~p NoHashMem=~p NoTreeMem=~p\n",[YesMem,NoHashMem,NoTreeMem]),
+
+ ?line YesMem = ets:info(Yes2,memory),
+ ?line YesMem = ets:info(Yes3,memory),
+ ?line YesMem = ets:info(Yes4,memory),
+ ?line YesMem = ets:info(Yes5,memory),
+ ?line YesMem = ets:info(Yes6,memory),
+ ?line NoHashMem = ets:info(No2,memory),
+ ?line NoHashMem = ets:info(No3,memory),
+ ?line NoTreeMem = ets:info(No5,memory),
+ ?line NoTreeMem = ets:info(No6,memory),
+ ?line NoHashMem = ets:info(No7,memory),
+ ?line NoHashMem = ets:info(No8,memory),
+
+ case erlang:system_info(smp_support) of
+ true ->
+ ?line true = YesMem > NoHashMem,
+ ?line true = YesMem > NoTreeMem;
+ false ->
+ ?line true = YesMem =:= NoHashMem
+ end,
+
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency,foo}])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency}])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,{write_concurrency,true,foo}])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(foo,[public,write_concurrency])),
+
+ lists:foreach(fun(T) -> ets:delete(T) end,
+ [Yes1,Yes2,Yes3,Yes4,Yes5,Yes6,
+ No1,No2,No3,No4,No5,No6,No7,No8]),
+ ?line verify_etsmem(EtsMem),
+ ok.
+
+
+heir(doc) -> ["The 'heir' option"];
+heir(suite) -> [];
+heir(Config) when is_list(Config) ->
+ repeat_for_opts(heir_do).
+
+heir_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ Master = self(),
+
+ %% Different types of heir data and link/monitor relations
+ TestFun = fun(Arg) -> {EtsMem,Arg} end,
+ Combos = [{Data,Mode} || Data<-[foo_data, <<"binary">>,
+ lists:seq(1,10), {17,TestFun,self()},
+ "The busy heir"],
+ Mode<-[none,link,monitor]],
+ ?line lists:foreach(fun({Data,Mode})-> heir_1(Data,Mode,Opts) end,
+ Combos),
+
+ %% No heir
+ {Founder1,MrefF1} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
+ Founder1 ! {go, none},
+ ?line {"No heir",Founder1} = receive_any(),
+ ?line {'DOWN', MrefF1, process, Founder1, normal} = receive_any(),
+ ?line undefined = ets:info(foo),
+
+ %% An already dead heir
+ {Heir2,MrefH2} = spawn_monitor(fun()->die end),
+ ?line {'DOWN', MrefH2, process, Heir2, normal} = receive_any(),
+ {Founder2,MrefF2} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
+ Founder2 ! {go, Heir2},
+ ?line {"No heir",Founder2} = receive_any(),
+ ?line {'DOWN', MrefF2, process, Founder2, normal} = receive_any(),
+ ?line undefined = ets:info(foo),
+
+ %% When heir dies before founder
+ {Founder3,MrefF3} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
+ {Heir3,MrefH3} = spawn_monitor(fun()->heir_heir(Founder3)end),
+ Founder3 ! {go, Heir3},
+ ?line {'DOWN', MrefH3, process, Heir3, normal} = receive_any(),
+ Founder3 ! die_please,
+ ?line {'DOWN', MrefF3, process, Founder3, normal} = receive_any(),
+ ?line undefined = ets:info(foo),
+
+ %% When heir dies and pid reused before founder dies
+ erts_debug:set_internal_state(available_internal_state,true),
+ NextPidIx = erts_debug:get_internal_state(next_pid),
+ {Founder4,MrefF4} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
+ {Heir4,MrefH4} = spawn_monitor(fun()->heir_heir(Founder4)end),
+ Founder4 ! {go, Heir4},
+ ?line {'DOWN', MrefH4, process, Heir4, normal} = receive_any(),
+ erts_debug:set_internal_state(next_pid, NextPidIx),
+ erts_debug:set_internal_state(available_internal_state,false),
+ {Heir4,MrefH4_B} = spawn_monitor_with_pid(Heir4,
+ fun()-> ?line die_please = receive_any() end),
+ Founder4 ! die_please,
+ ?line {'DOWN', MrefF4, process, Founder4, normal} = receive_any(),
+ Heir4 ! die_please,
+ ?line {'DOWN', MrefH4_B, process, Heir4, normal} = receive_any(),
+ ?line undefined = ets:info(foo),
+
+ ?line verify_etsmem(EtsMem).
+
+heir_founder(Master, HeirData, Opts) ->
+ ?line {go,Heir} = receive_any(),
+ HeirTpl = case Heir of
+ none -> {heir,none};
+ _ -> {heir, Heir, HeirData}
+ end,
+ ?line T = ets:new(foo,[named_table, private, HeirTpl | Opts]),
+ ?line true = ets:insert(T,{key,1}),
+ ?line [{key,1}] = ets:lookup(T,key),
+ Self = self(),
+ ?line Self = ets:info(T,owner),
+ ?line case ets:info(T,heir) of
+ none ->
+ ?line true = (Heir =:= none) orelse (not is_process_alive(Heir)),
+ Master ! {"No heir",self()};
+
+ Heir ->
+ ?line true = is_process_alive(Heir),
+ Heir ! {table,T,HeirData},
+ die_please = receive_any()
+ end.
+
+
+heir_heir(Founder) ->
+ heir_heir(Founder, none).
+heir_heir(Founder, Mode) ->
+ ?line {table,T,HeirData} = receive_any(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
+ ?line case HeirData of
+ "The dying heir" -> exit(normal);
+ _ -> ok
+ end,
+
+ ?line Mref = case Mode of
+ link -> process_flag(trap_exit, true),
+ link(Founder);
+ monitor -> erlang:monitor(process,Founder);
+ none -> ok
+ end,
+ ?line Founder ! die_please,
+ ?line Msg = case HeirData of
+ "The busy heir" -> receive_any_spinning();
+ _ -> receive_any()
+ end,
+ ?line {'ETS-TRANSFER', T, Founder, HeirData} = Msg,
+ ?line foo = T,
+ ?line Self = self(),
+ ?line Self = ets:info(T,owner),
+ ?line Self = ets:info(T,heir),
+ ?line [{key,1}] = ets:lookup(T,key),
+ ?line true = ets:insert(T,{key,2}),
+ ?line [{key,2}] = ets:lookup(T,key),
+ ?line case Mode of % Verify that EXIT or DOWN comes after ETS-TRANSFER
+ link ->
+ {'EXIT',Founder,normal} = receive_any(),
+ process_flag(trap_exit, false);
+ monitor ->
+ {'DOWN', Mref, process, Founder, normal} = receive_any();
+ none -> ok
+ end.
+
+
+heir_1(HeirData,Mode,Opts) ->
+ io:format("test with heir_data = ~p\n", [HeirData]),
+ Master = self(),
+ ?line Founder = spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end),
+ io:format("founder spawned = ~p\n", [Founder]),
+ ?line {Heir,Mref} = spawn_monitor(fun() -> heir_heir(Founder,Mode) end),
+ io:format("heir spawned = ~p\n", [{Heir,Mref}]),
+ ?line Founder ! {go, Heir},
+ ?line {'DOWN', Mref, process, Heir, normal} = receive_any().
+
+give_away(doc) -> ["ets:give_way/3"];
+give_away(suite) -> [];
+give_away(Config) when is_list(Config) ->
+ repeat_for_opts(give_away_do).
+
+give_away_do(Opts) ->
+ ?line T = ets:new(foo,[named_table, private | Opts]),
+ ?line true = ets:insert(T,{key,1}),
+ ?line [{key,1}] = ets:lookup(T,key),
+ Parent = self(),
+
+ %% Give and then give back
+ ?line {Receiver,Mref} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
+ ?line give_me = receive_any(),
+ ?line true = ets:give_away(T,Receiver,here_you_are),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
+ ?line Receiver ! give_back,
+ ?line {'ETS-TRANSFER',T,Receiver,"Tillbakakaka"} = receive_any(),
+ ?line [{key,2}] = ets:lookup(T,key),
+ ?line {'DOWN', Mref, process, Receiver, normal} = receive_any(),
+
+ %% Give and then let receiver keep it
+ ?line true = ets:insert(T,{key,1}),
+ ?line {Receiver3,Mref3} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
+ ?line give_me = receive_any(),
+ ?line true = ets:give_away(T,Receiver3,here_you_are),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
+ ?line Receiver3 ! die_please,
+ ?line {'DOWN', Mref3, process, Receiver3, normal} = receive_any(),
+ ?line undefined = ets:info(T),
+
+ %% Give and then kill receiver to get back
+ ?line T2 = ets:new(foo,[private | Opts]),
+ ?line true = ets:insert(T2,{key,1}),
+ ?line ets:setopts(T2,{heir,self(),"Som en gummiboll..."}),
+ ?line {Receiver2,Mref2} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
+ ?line give_me = receive_any(),
+ ?line true = ets:give_away(T2,Receiver2,here_you_are),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T2,key)),
+ ?line Receiver2 ! die_please,
+ ?line {'ETS-TRANSFER',T2,Receiver2,"Som en gummiboll..."} = receive_any(),
+ ?line [{key,2}] = ets:lookup(T2,key),
+ ?line {'DOWN', Mref2, process, Receiver2, normal} = receive_any(),
+
+ %% Some negative testing
+ ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,Receiver,"To a dead one")),
+ ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,self(),"To myself")),
+ ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,"not a pid","To wrong type")),
+
+ ?line true = ets:delete(T2),
+ ?line {ReceiverNeg,MrefNeg} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
+ ?line give_me = receive_any(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,ReceiverNeg,"A deleted table")),
+
+ ?line T3 = ets:new(foo,[public | Opts]),
+ spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")),
+ Parent ! done
+ end),
+ ?line done = receive_any(),
+ ?line ReceiverNeg ! no_soup_for_you,
+ ?line {'DOWN', MrefNeg, process, ReceiverNeg, normal} = receive_any(),
+ ok.
+
+give_away_receiver(T, Giver) ->
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
+ ?line Giver ! give_me,
+ ?line case receive_any() of
+ {'ETS-TRANSFER',T,Giver,here_you_are} ->
+ ?line [{key,1}] = ets:lookup(T,key),
+ ?line true = ets:insert(T,{key,2}),
+ ?line case receive_any() of
+ give_back ->
+ ?line true = ets:give_away(T,Giver,"Tillbakakaka"),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key));
+ die_please ->
+ ok
+ end;
+ no_soup_for_you ->
+ ok
+ end.
+
+
+setopts(doc) -> ["ets:setopts/2"];
+setopts(suite) -> [];
+setopts(Config) when is_list(Config) ->
+ repeat_for_opts(setopts_do,[write_concurrency,all_types]).
+
+setopts_do(Opts) ->
+ Self = self(),
+ ?line T = ets:new(foo,[named_table, private | Opts]),
+ ?line none = ets:info(T,heir),
+ Heir = spawn_link(fun()->heir_heir(Self) end),
+ ?line ets:setopts(T,{heir,Heir,"Data"}),
+ ?line Heir = ets:info(T,heir),
+ ?line ets:setopts(T,{heir,self(),"Data"}),
+ ?line Self = ets:info(T,heir),
+ ?line ets:setopts(T,[{heir,Heir,"Data"}]),
+ ?line Heir = ets:info(T,heir),
+ ?line ets:setopts(T,[{heir,none}]),
+ ?line none = ets:info(T,heir),
+
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,[{heir,self(),"Data"},false])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{heir,self()})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{heir,false})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,heir)),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{heir,false,"Data"})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{false,self(),"Data"})),
+
+ ?line ets:setopts(T,{protection,protected}),
+ ?line ets:setopts(T,{protection,public}),
+ ?line ets:setopts(T,{protection,private}),
+ ?line ets:setopts(T,[{protection,protected}]),
+ ?line ets:setopts(T,[{protection,public}]),
+ ?line ets:setopts(T,[{protection,private}]),
+
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{protection})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{protection,false})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{protection,private,false})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,protection)),
+ ?line ets:delete(T),
+ ok.
+
+bad_table(doc) -> ["All kinds of operations with bad table argument"];
+bad_table(suite) -> [];
+bad_table(Config) when is_list(Config) ->
+
+ %% Open and close disk_log to stabilize etsmem.
+ Name = make_ref(),
+ ?line File = filename:join([?config(priv_dir, Config),"bad_table.dummy"]),
+ ?line {ok, Name} = disk_log:open([{name, Name}, {file, File}]),
+ ?line disk_log:close(Name),
+ file:delete(File),
+
+ ?line EtsMem = etsmem(),
+
+ repeat_for_opts(fun(Opts) -> bad_table_do(Opts,File) end,
+ [write_concurrency, all_types]),
+ ?line verify_etsmem(EtsMem),
+ ok.
+
+bad_table_do(Opts, DummyFile) ->
+ Parent = self(),
+ {Pid,Mref} = spawn_opt(fun()-> ets:new(priv,[private,named_table | Opts]),
+ Priv = ets:new(priv,[private | Opts]),
+ ets:new(prot,[protected,named_table | Opts]),
+ Prot = ets:new(prot,[protected | Opts]),
+ Parent ! {self(),Priv,Prot},
+ die_please = receive_any()
+ end,
+ [link, monitor]),
+ {Pid,Priv,Prot} = receive_any(),
+ MatchSpec = {{key,'_'}, [], ['$$']},
+ Fun = fun(X,_) -> X end,
+ OpList = [{delete,[key],update},
+ {delete_all_objects,[],update},
+ {delete_object,[{key,data}],update},
+ {first,[],read},
+ {foldl,[Fun, 0], read, tabarg_last},
+ {foldr,[Fun, 0], read, tabarg_last},
+ %%{from_dets,[DetsTab], update},
+ {give_away,[Pid, data], update},
+ %%{info, [], read},
+ %%{info, [safe_fixed], read},
+ %%{init_table,[Name, InitFun],update},
+ {insert, [{key,data}], update},
+ {insert_new, [{key,data}], update},
+ {insert_new, [[{key,data},{other,data}]], update},
+ {last, [], read},
+ {lookup, [key], read},
+ {lookup_element, [key, 2], read},
+ {match, [{}], read},
+ {match, [{},17], read},
+ {match_delete, [{}], update},
+ {match_object, [{}], read},
+ {match_object, [{},17], read},
+ {member,[key], read},
+ {next, [key], read},
+ {prev, [key], read},
+ {rename, [new_name], update},
+ {safe_fixtable, [true], read},
+ {select,[MatchSpec], read},
+ {select,[MatchSpec,17], read},
+ {select_count,[MatchSpec], read},
+ {select_delete,[MatchSpec], update},
+ {setopts, [{heir,none}], update},
+ {slot, [0], read},
+ {tab2file, [DummyFile], read, {return,{error,badtab}}},
+ {tab2file, [DummyFile,[]], read, {return,{error,badtab}}},
+ {tab2list, [], read},
+ %%{table,[], read},
+ %%{to_dets, [DetsTab], read},
+ {update_counter,[key,1], update},
+ {update_element,[key,{2,new_data}], update}
+ ],
+ Info = {Opts, Priv, Prot},
+ lists:foreach(fun(Op) -> bad_table_op(Info, Op) end,
+ OpList),
+ Pid ! die_please,
+ {'DOWN', Mref, process, Pid, normal} = receive_any(),
+ ok.
+
+bad_table_op({Opts,Priv,Prot}, Op) ->
+ %%io:format("Doing Op=~p on ~p's\n",[Op,Type]),
+ T1 = ets:new(noname,Opts),
+ bad_table_call(noname,Op),
+ ets:delete(T1),
+ bad_table_call(T1,Op),
+ T2 = ets:new(named,[named_table | Opts]),
+ ets:delete(T2),
+ bad_table_call(named,Op),
+ bad_table_call(T2,Op),
+ bad_table_call(priv,Op),
+ bad_table_call(Priv,Op),
+ case element(3,Op) of
+ update ->
+ bad_table_call(prot,Op),
+ bad_table_call(Prot,Op);
+ read -> ok
+ end.
+
+bad_table_call(T,{F,Args,_}) ->
+ ?line {'EXIT',{badarg,_}} = (catch apply(ets, F, [T|Args]));
+bad_table_call(T,{F,Args,_,tabarg_last}) ->
+ ?line {'EXIT',{badarg,_}} = (catch apply(ets, F, Args++[T]));
+bad_table_call(T,{F,Args,_,{return,Return}}) ->
+ try
+ ?line Return = apply(ets, F, [T|Args])
+ catch
+ error:badarg -> ok
+ end.
+
+
+rename(doc) ->
+ ["Check rename of ets tables"];
+rename(suite) ->
+ [];
+rename(Config) when is_list(Config) ->
+ repeat_for_opts(rename_do, [write_concurrency, all_types]).
+
+rename_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ets:new(foobazz,[named_table, public | Opts]),
+ ets:insert(foobazz,{foo,bazz}),
+ ungermanbazz = ets:rename(foobazz,ungermanbazz),
+ {'EXIT',{badarg, _}} = (catch ets:lookup(foobazz,foo)),
+ [{foo,bazz}] = ets:lookup(ungermanbazz,foo),
+ {'EXIT',{badarg,_}} = (catch ets:rename(ungermanbazz,"no atom")),
+ ets:delete(ungermanbazz),
+ ?line verify_etsmem(EtsMem).
+
+rename_unnamed(doc) ->
+ ["Check rename of unnamed ets table"];
+rename_unnamed(suite) ->
+ [];
+rename_unnamed(Config) when is_list(Config) ->
+ repeat_for_opts(rename_unnamed_do,[write_concurrency,all_types]).
+
+rename_unnamed_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(bonkz,[public | Opts]),
+ ?line {'EXIT',{badarg, _}} = (catch ets:insert(bonkz,{foo,bazz})),
+ ?line bonkz = ets:info(Tab, name),
+ ?line Tab = ets:rename(Tab, tjabonkz),
+ ?line {'EXIT',{badarg, _}} = (catch ets:insert(tjabonkz,{foo,bazz})),
+ ?line tjabonkz = ets:info(Tab, name),
+ ?line ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+evil_rename(doc) ->
+ "Rename a table with many fixations, and at the same time delete it.";
+evil_rename(Config) when is_list(Config) ->
+ ?line evil_rename_1(old_hash, new_hash, [public,named_table]),
+ ?line EtsMem = etsmem(),
+ ?line evil_rename_1(old_tree, new_tree, [public,ordered_set,named_table]),
+ ?line verify_etsmem(EtsMem).
+
+evil_rename_1(Old, New, Flags) ->
+ ?line process_flag(trap_exit, true),
+ ?line Old = ets:new(Old, Flags),
+ ?line Fixer = fun() -> ets:safe_fixtable(Old, true) end,
+ ?line crazy_fixtable(15000, Fixer),
+ ?line erlang:yield(),
+ ?line New = ets:rename(Old, New),
+ ?line erlang:yield(),
+ ets:delete(New),
+ ok.
+
+crazy_fixtable(N, Fixer) ->
+ Dracula = ets:new(count_dracula, [public]),
+ ets:insert(Dracula, {count,0}),
+ SpawnFun = fun() ->
+ Fixer(),
+ case ets:update_counter(Dracula, count, 1) rem 15 of
+ 0 -> evil_creater_destroyer();
+ _ -> erlang:hibernate(erlang, error, [dont_wake_me])
+ end
+ end,
+ crazy_fixtable_1(N, SpawnFun),
+ crazy_fixtable_wait(N, Dracula),
+ Dracula.
+
+crazy_fixtable_wait(N, Dracula) ->
+ case ets:lookup(Dracula, count) of
+ [{count,N}] ->
+ ets:delete(Dracula);
+ Other ->
+ io:format("~p\n", [Other]),
+ receive after 10 -> ok end,
+ crazy_fixtable_wait(N, Dracula)
+ end.
+
+crazy_fixtable_1(0, _) ->
+ ok;
+crazy_fixtable_1(N, Fun) ->
+ spawn_link(Fun),
+ crazy_fixtable_1(N-1, Fun).
+
+evil_creater_destroyer() ->
+ T1 = evil_create_fixed_tab(),
+ ets:delete(T1).
+
+evil_create_fixed_tab() ->
+ T = ets:new(arne, [public]),
+ ets:safe_fixtable(T, true),
+ T.
+
+interface_equality(doc) ->
+ ["Tests that the return values and errors are equal for set's and"
+ " ordered_set's where applicable"];
+interface_equality(suite) ->
+ [];
+interface_equality(Config) when is_list(Config) ->
+ repeat_for_opts(interface_equality_do).
+
+interface_equality_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Set = ets:new(set,[set | Opts]),
+ ?line OrderedSet = ets:new(ordered_set,[ordered_set | Opts]),
+ ?line F = fun(X,T,FF) -> case X of
+ 0 -> true;
+ _ ->
+ ets:insert(T, {X,
+ integer_to_list(X),
+ X rem 10}),
+ FF(X-1,T,FF)
+ end
+ end,
+ ?line F(100,Set,F),
+ ?line F(100,OrderedSet,F),
+ ?line equal_results(ets, insert, Set, OrderedSet, [{a,"a"}]),
+ ?line equal_results(ets, insert, Set, OrderedSet, [{1,1,"1"}]),
+ ?line equal_results(ets, lookup, Set, OrderedSet, [10]),
+ ?line equal_results(ets, lookup, Set, OrderedSet, [1000]),
+ ?line equal_results(ets, delete, Set, OrderedSet, [10]),
+ ?line equal_results(ets, delete, Set, OrderedSet, [nott]),
+ ?line equal_results(ets, lookup, Set, OrderedSet, [1000]),
+ ?line equal_results(ets, insert, Set, OrderedSet, [10]),
+ ?line equal_results(ets, next, Set, OrderedSet, ['$end_of_table']),
+ ?line equal_results(ets, prev, Set, OrderedSet, ['$end_of_table']),
+ ?line equal_results(ets, match, Set, OrderedSet, [{'_','_','_'}]),
+ ?line equal_results(ets, match, Set, OrderedSet, [{'_','_','_','_'}]),
+ ?line equal_results(ets, match, Set, OrderedSet, [{$3,$2,2}]),
+ ?line equal_results(ets, match, Set, OrderedSet, ['_']),
+ ?line equal_results(ets, match, Set, OrderedSet, ['$1']),
+ ?line equal_results(ets, match, Set, OrderedSet, [{'_','$50',3}]),
+ ?line equal_results(ets, match, Set, OrderedSet, [['_','$50',3]]),
+ ?line equal_results(ets, match_delete, Set, OrderedSet, [{'_','_',4}]),
+ ?line equal_results(ets, match_delete, Set, OrderedSet, [{'_','_',4}]),
+ ?line equal_results(ets, match_object, Set, OrderedSet, [{'_','_',4}]),
+ ?line equal_results(ets, match_object, Set, OrderedSet, [{'_','_',5}]),
+ ?line equal_results(ets, match_object, Set, OrderedSet, [{'_','_',4}]),
+ ?line equal_results(ets, match_object, Set, OrderedSet, ['_']),
+ ?line equal_results(ets, match_object, Set, OrderedSet, ['$5011']),
+ ?line equal_results(ets, match_delete, Set, OrderedSet, ['$20']),
+ ?line equal_results(ets, lookup_element, Set, OrderedSet, [13,2]),
+ ?line equal_results(ets, lookup_element, Set, OrderedSet, [13,4]),
+ ?line equal_results(ets, lookup_element, Set, OrderedSet, [14,2]),
+ ?line equal_results(ets, delete, Set, OrderedSet, []),
+ ?line verify_etsmem(EtsMem).
+
+equal_results(M, F, FirstArg1, FirstArg2 ,ACommon) ->
+ Res = maybe_sort((catch apply(M,F, [FirstArg1 | ACommon]))),
+ Res = maybe_sort((catch apply(M,F,[FirstArg2 | ACommon]))).
+
+maybe_sort(L) when is_list(L) ->
+ lists:sort(L);
+%maybe_sort({'EXIT',{Reason, [{Module, Function, _}|_]}}) ->
+% {'EXIT',{Reason, [{Module, Function, '_'}]}};
+maybe_sort({'EXIT',{Reason, List}}) when is_list(List) ->
+ {'EXIT',{Reason, lists:map(fun({Module, Function, _}) ->
+ {Module, Function, '_'}
+ end,
+ List)}};
+maybe_sort(Any) ->
+ Any.
+
+ordered_match(doc) ->
+ ["Test match, match_object and match_delete in ordered set's"];
+ordered_match(suite) ->
+ [];
+ordered_match(Config) when is_list(Config)->
+ repeat_for_opts(ordered_match_do).
+
+ordered_match_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line F = fun(X,T,FF) -> case X of
+ 0 -> true;
+ _ ->
+ ets:insert(T, {X,
+ integer_to_list(X),
+ X rem 10,
+ X rem 100,
+ X rem 1000}),
+ FF(X-1,T,FF)
+ end
+ end,
+ ?line T1 = ets:new(xxx,[ordered_set| Opts]),
+ ?line F(3000,T1,F),
+ ?line [[3,3],[3,3],[3,3]] = ets:match(T1, {'_','_','$1','$2',3}),
+ ?line F2 = fun(X,Rem,Res,FF) -> case X of
+ 0 -> [];
+ _ ->
+ case X rem Rem of
+ Res ->
+ FF(X-1,Rem,Res,FF) ++
+ [{X,
+ integer_to_list(X),
+ X rem 10,
+ X rem 100,
+ X rem 1000}];
+ _ ->
+ FF(X-1,Rem,Res,FF)
+ end
+ end
+ end,
+ ?line OL1 = F2(3000,100,2,F2),
+ ?line OL1 = ets:match_object(T1, {'_','_','_',2,'_'}),
+ ?line true = ets:match_delete(T1,{'_','_','_',2,'_'}),
+ ?line [] = ets:match_object(T1, {'_','_','_',2,'_'}),
+ ?line OL2 = F2(3000,100,3,F2),
+ ?line OL2 = ets:match_object(T1, {'_','_','_',3,'_'}),
+ ?line ets:delete(T1),
+ ?line verify_etsmem(EtsMem).
+
+
+ordered(doc) ->
+ ["Test basic functionality in ordered_set's."];
+ordered(suite) ->
+ [];
+ordered(Config) when is_list(Config) ->
+ repeat_for_opts(ordered_do).
+
+ordered_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line T = ets:new(oset, [ordered_set | Opts]),
+ ?line InsList = [
+ 25,26,27,28,
+ 5,6,7,8,
+ 21,22,23,24,
+ 9,10,11,12,
+ 1,2,3,4,
+ 17,18,19,20,
+ 13,14,15,16
+ ],
+ ?line lists:foreach(fun(X) ->
+ ets:insert(T,{X,integer_to_list(X)})
+ end,
+ InsList),
+ ?line IL2 = lists:map(fun(X) -> {X,integer_to_list(X)} end, InsList),
+ ?line L1 = pick_all_forward(T),
+ ?line L2 = pick_all_backwards(T),
+ ?line S1 = lists:sort(IL2),
+ ?line S2 = lists:reverse(lists:sort(IL2)),
+ ?line S1 = L1,
+ ?line S2 = L2,
+ ?line [{1,"1"}] = ets:slot(T,0),
+ ?line [{28,"28"}] = ets:slot(T,27),
+ ?line 27 = ets:prev(T,28),
+ ?line [{7,"7"}] = ets:slot(T,6),
+ ?line '$end_of_table' = ets:next(T,28),
+ ?line [{12,"12"}] = ets:slot(T,11),
+ ?line '$end_of_table' = ets:slot(T,28),
+ ?line [{1,"1"}] = ets:slot(T,0),
+ ?line 28 = ets:prev(T,29),
+ ?line 1 = ets:next(T,0),
+ ?line pick_all_forward(T),
+ ?line [{7,"7"}] = ets:slot(T,6),
+ ?line L2 = pick_all_backwards(T),
+ ?line [{7,"7"}] = ets:slot(T,6),
+ ?line ets:delete(T),
+ ?line verify_etsmem(EtsMem).
+
+pick_all(_T,'$end_of_table',_How) ->
+ [];
+pick_all(T,Last,How) ->
+ ?line This = case How of
+ next ->
+ ?line ets:next(T,Last);
+ prev ->
+ ?line ets:prev(T,Last)
+ end,
+ ?line [LastObj] = ets:lookup(T,Last),
+ ?line [LastObj | pick_all(T,This,How)].
+
+pick_all_forward(T) ->
+ ?line pick_all(T,ets:first(T),next).
+pick_all_backwards(T) ->
+ ?line pick_all(T,ets:last(T),prev).
+
+
+
+setbag(doc) -> ["Small test case for both set and bag type ets tables."];
+setbag(suite) -> [];
+setbag(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Set = ets:new(set,[set]),
+ ?line Bag = ets:new(bag,[bag]),
+ ?line Key = {foo,bar},
+
+ %% insert some value
+ ?line ets:insert(Set,{Key,val1}),
+ ?line ets:insert(Bag,{Key,val1}),
+
+ %% insert new value for same key again
+ ?line ets:insert(Set,{Key,val2}),
+ ?line ets:insert(Bag,{Key,val2}),
+
+ %% check
+ ?line [{Key,val2}] = ets:lookup(Set,Key),
+ ?line [{Key,val1},{Key,val2}] = ets:lookup(Bag,Key),
+
+ true = ets:delete(Set),
+ true = ets:delete(Bag),
+ ?line verify_etsmem(EtsMem).
+
+badnew(doc) ->
+ ["Test case to check proper return values for illegal ets:new() calls."];
+badnew(suite) -> [];
+badnew(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(12,[])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new({a,b},[])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(name,[foo])),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(name,{bag})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(name,bag)),
+ ?line verify_etsmem(EtsMem).
+
+verybadnew(doc) ->
+ ["Test case to check that a not well formed list does not crash the "
+ "emulator. OTP-2314 "];
+verybadnew(suite) -> [];
+verybadnew(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:new(verybad,[set|protected])),
+ ?line verify_etsmem(EtsMem).
+
+named(doc) -> ["Small check to see if named tables work."];
+named(suite) -> [];
+named(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = make_table(foo,
+ [named_table],
+ [{key,val}]),
+ ?line [{key,val}] = ets:lookup(foo,key),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+keypos2(doc) -> ["Test case to check if specified keypos works."];
+keypos2(suite) -> [];
+keypos2(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = make_table(foo,
+ [set,{keypos,2}],
+ [{val,key}, {val2,key}]),
+ ?line [{val2,key}] = ets:lookup(Tab,key),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+privacy(doc) ->
+ ["Privacy check. Check that a named(public/private/protected) table "
+ "cannot be read by",
+ "the wrong process(es)."];
+privacy(suite) -> [];
+privacy(Config) when is_list(Config) ->
+ repeat_for_opts(privacy_do).
+
+privacy_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line process_flag(trap_exit,true),
+ ?line Owner = my_spawn_link(?MODULE,privacy_owner,[self(),Opts]),
+ receive
+ {'EXIT',Owner,Reason} ->
+ ?line exit({privacy_test,Reason});
+ ok ->
+ ok
+ end,
+
+ privacy_check(pub,prot,priv),
+
+ Owner ! {shift,1,{pub,prot,priv}},
+ receive {Pub1,Prot1,Priv1} -> ok end,
+ privacy_check(Pub1,Prot1,Priv1),
+
+ Owner ! {shift,2,{Pub1,Prot1,Priv1}},
+ receive {Pub2,Prot2,Priv2} -> ok end,
+ privacy_check(Pub2,Prot2,Priv2),
+
+ Owner ! {shift,0,{Pub2,Prot2,Priv2}},
+ receive {Pub2,Prot2,Priv2} -> ok end,
+ privacy_check(Pub2,Prot2,Priv2),
+
+ Owner ! die,
+ receive {'EXIT',Owner,_} -> ok end,
+ ?line verify_etsmem(EtsMem).
+
+privacy_check(Pub,Prot,Priv) ->
+ %% check read rights
+ ?line [] = ets:lookup(Pub, foo),
+ ?line [] = ets:lookup(Prot,foo),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(Priv,foo)),
+
+ %% check write rights
+ ?line true = ets:insert(Pub, {1,foo}),
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(Prot,{2,foo})),
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(Priv,{3,foo})),
+
+ %% check that it really wasn't written, either
+ ?line [] = ets:lookup(Prot,foo).
+
+privacy_owner(Boss, Opts) ->
+ ets:new(pub, [public,named_table | Opts]),
+ ets:new(prot,[protected,named_table | Opts]),
+ ets:new(priv,[private,named_table | Opts]),
+ Boss ! ok,
+ privacy_owner_loop(Boss).
+
+privacy_owner_loop(Boss) ->
+ receive
+ {shift,N,Pub_Prot_Priv} ->
+ {Pub,Prot,Priv} = rotate_tuple(Pub_Prot_Priv, N),
+
+ ets:setopts(Pub,{protection,public}),
+ ets:setopts(Prot,{protection,protected}),
+ ets:setopts(Priv,{protection,private}),
+ Boss ! {Pub,Prot,Priv},
+ privacy_owner_loop(Boss);
+
+ die -> ok
+ end.
+
+rotate_tuple(Tuple, 0) ->
+ Tuple;
+rotate_tuple(Tuple, N) ->
+ [H|T] = tuple_to_list(Tuple),
+ rotate_tuple(list_to_tuple(T ++ [H]), N-1).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+insert(doc) -> ["Test proper and improper inserts into a table."];
+insert(suite) -> [empty,badinsert].
+
+empty(doc) ->
+ ["Check lookup in an empty table and lookup of a non-existing key"];
+empty(suite) -> [];
+empty(Config) when is_list(Config) ->
+ repeat_for_opts(empty_do).
+
+empty_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line [] = ets:lookup(Tab,key),
+ ?line true = ets:insert(Tab,{key2,val}),
+ ?line [] = ets:lookup(Tab,key),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+badinsert(doc) ->
+ ["Check proper return values for illegal insert operations."];
+badinsert(suite) -> [];
+badinsert(Config) when is_list(Config) ->
+ repeat_for_opts(badinsert_do).
+
+badinsert_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(foo,{key,val})),
+
+ ?line Tab = ets:new(foo,Opts),
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab,{})),
+
+ ?line Tab3 = ets:new(foo,[{keypos,3}| Opts]),
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab3,{a,b})),
+
+ ?line {'EXIT',{badarg,_}} = (catch ets:insert(Tab,[key,val2])),
+ ?line true = ets:delete(Tab),
+ ?line true = ets:delete(Tab3),
+ ?line verify_etsmem(EtsMem).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+lookup(doc) -> ["Some tests for lookups (timing, bad lookups, etc.)."];
+lookup(suite) -> [time_lookup,badlookup,lookup_order].
+
+time_lookup(doc) -> ["Lookup timing."];
+time_lookup(suite) -> [];
+time_lookup(Config) when is_list(Config) ->
+ %% just for timing, really
+ ?line EtsMem = etsmem(),
+ Values = repeat_for_opts(time_lookup_do),
+ ?line verify_etsmem(EtsMem),
+ ?line {comment,lists:flatten(io_lib:format(
+ "~p ets lookups/s",[Values]))}.
+
+time_lookup_do(Opts) ->
+ ?line Tab = ets:new(foo,Opts),
+ ?line fill_tab(Tab,foo),
+ ?line ets:insert(Tab,{{a,key},foo}),
+ ?line {Time,_} = ?t:timecall(test_server,do_times,
+ [10000,ets,lookup,[Tab,{a,key}]]),
+ ?line true = ets:delete(Tab),
+ round(10000 / Time). % lookups/s
+
+badlookup(doc) ->
+ ["Check proper return values from bad lookups in existing/non existing "
+ " ets tables"];
+badlookup(suite) -> [];
+badlookup(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(foo,key)),
+ ?line Tab = ets:new(foo,[]),
+ ?line ets:delete(Tab),
+ ?line {'EXIT',{badarg,_}} = (catch ets:lookup(Tab,key)),
+ ?line verify_etsmem(EtsMem).
+
+lookup_order(doc) -> ["Test that lookup returns objects in order of insertion for bag and dbag."];
+lookup_order(suite) -> [];
+lookup_order(Config) when is_list(Config) ->
+ EtsMem = etsmem(),
+ repeat_for_opts(lookup_order_do, [write_concurrency,[bag,duplicate_bag]]),
+ ?line verify_etsmem(EtsMem),
+ ok.
+
+lookup_order_do(Opts) ->
+ lookup_order_2(Opts, false),
+ lookup_order_2(Opts, true).
+
+lookup_order_2(Opts, Fixed) ->
+ io:format("Opts=~p Fixed=~p\n",[Opts,Fixed]),
+
+ A = 1, B = 2, C = 3,
+ ABC = [A,B,C],
+ Pair = [{A,B},{B,A},{A,C},{C,A},{B,C},{C,B}],
+ Combos = [{D1,D2,D3} || D1<-ABC, D2<-Pair, D3<-Pair],
+ lists:foreach(fun({D1,{D2a,D2b},{D3a,D3b}}) ->
+ T = ets:new(foo,Opts),
+ case Fixed of
+ true -> ets:safe_fixtable(T,true);
+ false -> ok
+ end,
+ S10 = {T,[],key},
+ S20 = check_insert(S10,A),
+ S30 = check_insert(S20,B),
+ S40 = check_insert(S30,C),
+ S50 = check_delete(S40,D1),
+ S55 = check_insert(S50,D1),
+ S60 = check_insert(S55,D1),
+ S70 = check_delete(S60,D2a),
+ S80 = check_delete(S70,D2b),
+ S90 = check_insert(S80,D2a),
+ SA0 = check_delete(S90,D3a),
+ SB0 = check_delete(SA0,D3b),
+ check_insert_new(SB0,D3b),
+
+ true = ets:delete(T)
+ end,
+ Combos).
+
+
+check_insert({T,List0,Key},Val) ->
+ %%io:format("insert ~p into ~p\n",[Val,List0]),
+ ets:insert(T,{Key,Val}),
+ List1 = case (ets:info(T,type) =:= bag andalso
+ lists:member({Key,Val},List0)) of
+ true -> List0;
+ false -> [{Key,Val} | List0]
+ end,
+ check_check({T,List1,Key}).
+
+check_insert_new({T,List0,Key},Val) ->
+ %%io:format("insert_new ~p into ~p\n",[Val,List0]),
+ Ret = ets:insert_new(T,{Key,Val}),
+ ?line Ret = (List0 =:= []),
+ List1 = case Ret of
+ true -> [{Key,Val}];
+ false -> List0
+ end,
+ check_check({T,List1,Key}).
+
+
+check_delete({T,List0,Key},Val) ->
+ %%io:format("delete ~p from ~p\n",[Val,List0]),
+ ets:delete_object(T,{Key,Val}),
+ List1 = lists:filter(fun(Obj) -> Obj =/= {Key,Val} end,
+ List0),
+ check_check({T,List1,Key}).
+
+check_check(S={T,List,Key}) ->
+ case lists:reverse(ets:lookup(T,Key)) of
+ List -> ok;
+ ETS -> io:format("check failed:\nETS: ~p\nCHK: ~p\n", [ETS,List]),
+ ?t:fail("Invalid return value from ets:lookup")
+ end,
+ ?line Items = ets:info(T,size),
+ ?line Items = length(List),
+ S.
+
+
+
+fill_tab(Tab,Val) ->
+ ?line ets:insert(Tab,{key,Val}),
+ ?line ets:insert(Tab,{{a,144},Val}),
+ ?line ets:insert(Tab,{{a,key2},Val}),
+ ?line ets:insert(Tab,{14,Val}),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+lookup_element(doc) -> ["Some tests for lookup_element."];
+lookup_element(suite) -> [lookup_element_mult].
+
+lookup_element_mult(doc) -> ["Multiple return elements (OTP-2386)"];
+lookup_element_mult(suite) -> [];
+lookup_element_mult(Config) when is_list(Config) ->
+ repeat_for_opts(lookup_element_mult_do).
+
+lookup_element_mult_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line T = ets:new(service, [bag, {keypos, 2} | Opts]),
+ ?line D = lists:reverse(lem_data()),
+ ?line lists:foreach(fun(X) -> ets:insert(T, X) end, D),
+ ?line ok = lem_crash_3(T),
+ ?line true = ets:delete(T),
+ ?line verify_etsmem(EtsMem).
+
+lem_data() ->
+ [
+ {service,'eddie2@boromir',{150,236,14,103},httpd88,self()},
+ {service,'eddie2@boromir',{150,236,14,103},httpd80,self()},
+ {service,'eddie3@boromir',{150,236,14,107},httpd88,self()},
+ {service,'eddie3@boromir',{150,236,14,107},httpd80,self()},
+ {service,'eddie4@boromir',{150,236,14,108},httpd88,self()}
+ ].
+
+lem_crash(T) ->
+ L = ets:lookup_element(T, 'eddie2@boromir', 3),
+ {erlang:phash(L, 256), L}.
+
+lem_crash_3(T) ->
+ lem_crash(T),
+ io:format("Survived once~n"),
+ lem_crash(T),
+ io:format("Survived twice~n"),
+ lem_crash(T),
+ io:format("Survived all!~n"),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+delete(doc) ->
+ ["Check delete functionality (proper/improper deletes)"];
+delete(suite) ->
+ [delete_elem,delete_tab,delete_large_tab,delete_large_named_table,evil_delete,
+ table_leak,baddelete,match_delete,match_delete3].
+
+delete_elem(doc) ->
+ ["Check delete of an element inserted in a `filled' table."];
+delete_elem(suite) -> [];
+delete_elem(Config) when is_list(Config) ->
+ repeat_for_opts(delete_elem_do, [write_concurrency, all_types]).
+
+delete_elem_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line fill_tab(Tab,foo),
+ ?line ets:insert(Tab,{{b,key},foo}),
+ ?line ets:insert(Tab,{{c,key},foo}),
+ ?line true = ets:delete(Tab,{b,key}),
+ ?line [] = ets:lookup(Tab,{b,key}),
+ ?line [{{c,key},foo}] = ets:lookup(Tab,{c,key}),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+delete_tab(doc) ->
+ ["Check that ets:delete() works and releases the name of the deleted "
+ "table."];
+delete_tab(suite) -> [];
+delete_tab(Config) when is_list(Config) ->
+ repeat_for_opts(delete_tab_do,[write_concurrency,all_types]).
+
+delete_tab_do(Opts) ->
+ Name = foo,
+ ?line EtsMem = etsmem(),
+ ?line Name = ets:new(Name, [named_table | Opts]),
+ ?line true = ets:delete(foo),
+ %% The name should be available again.
+ ?line Name = ets:new(Name, [named_table | Opts]),
+ ?line true = ets:delete(Name),
+ ?line verify_etsmem(EtsMem).
+
+delete_large_tab(doc) ->
+ "Check that ets:delete/1 works and that other processes can run.";
+delete_large_tab(Config) when is_list(Config) ->
+ ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(fun(Opts) -> delete_large_tab_do(Opts,Data) end),
+ ?line verify_etsmem(EtsMem).
+
+delete_large_tab_do(Opts,Data) ->
+ ?line delete_large_tab_1(foo_hash, Opts, Data, false),
+ ?line delete_large_tab_1(foo_tree, [ordered_set | Opts], Data, false),
+ ?line delete_large_tab_1(foo_hash, Opts, Data, true).
+
+
+delete_large_tab_1(Name, Flags, Data, Fix) ->
+ ?line Tab = ets:new(Name, Flags),
+ ?line ets:insert(Tab, Data),
+
+ case Fix of
+ false -> ok;
+ true ->
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data)
+ end,
+
+ {priority, Prio} = process_info(self(), priority),
+ ?line Deleter = self(),
+ ?line [SchedTracer]
+ = start_loopers(1,
+ Prio,
+ fun (SC) ->
+ receive
+ {trace, Deleter, out, _} ->
+ undefined = ets:info(Tab),
+ SC+1;
+ {trace,
+ Deleter,
+ register,
+ delete_large_tab_done_marker}->
+ Deleter ! {schedule_count, SC},
+ exit(normal);
+ _ ->
+ SC
+ end
+ end,
+ 0),
+ ?line Loopers = start_loopers(erlang:system_info(schedulers),
+ Prio,
+ fun (_) -> erlang:yield() end,
+ ok),
+ ?line erlang:yield(),
+ ?line 1 = erlang:trace(self(),true,[running,procs,{tracer,SchedTracer}]),
+ ?line true = ets:delete(Tab),
+ %% The register stuff is just a trace marker
+ ?line true = register(delete_large_tab_done_marker, self()),
+ ?line true = unregister(delete_large_tab_done_marker),
+ ?line undefined = ets:info(Tab),
+ ?line ok = stop_loopers(Loopers),
+ ?line receive
+ {schedule_count, N} ->
+ ?line io:format("~s: context switches: ~p", [Name,N]),
+ if
+ N >= 5 -> ?line ok;
+ true -> ?line ?t:fail()
+ end
+ end.
+
+delete_large_named_table(doc) ->
+ "Delete a large name table and try to create a new table with the same name in another process.";
+delete_large_named_table(Config) when is_list(Config) ->
+ ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(fun(Opts) -> delete_large_named_table_do(Opts,Data) end),
+ ?line verify_etsmem(EtsMem),
+ ok.
+
+delete_large_named_table_do(Opts,Data) ->
+ ?line delete_large_named_table_1(foo_hash, [named_table | Opts], Data, false),
+ ?line delete_large_named_table_1(foo_tree, [ordered_set,named_table | Opts], Data, false),
+ ?line delete_large_named_table_1(foo_hash, [named_table | Opts], Data, true).
+
+delete_large_named_table_1(Name, Flags, Data, Fix) ->
+ ?line Tab = ets:new(Name, Flags),
+ ?line ets:insert(Tab, Data),
+
+ case Fix of
+ false -> ok;
+ true ->
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data)
+ end,
+ Parent = self(),
+ Pid = spawn_link(fun() ->
+ receive
+ {trace,Parent,call,_} ->
+ ets:new(Name, [named_table])
+ end
+ end),
+ ?line erlang:trace(self(), true, [call,{tracer,Pid}]),
+ ?line erlang:trace_pattern({ets,delete,1}, true, [global]),
+ ?line erlang:yield(), true = ets:delete(Tab),
+ ?line erlang:trace_pattern({ets,delete,1}, false, [global]),
+ ok.
+
+evil_delete(doc) ->
+ "Delete a large table, and kill the process during the delete.";
+evil_delete(Config) when is_list(Config) ->
+ ?line Data = [{I,I*I} || I <- lists:seq(1, 100000)],
+ repeat_for_opts(fun(Opts) -> evil_delete_do(Opts,Data) end).
+
+evil_delete_do(Opts,Data) ->
+ ?line EtsMem = etsmem(),
+ ?line evil_delete_owner(foo_hash, Opts, Data, false),
+ ?line verify_etsmem(EtsMem),
+ ?line evil_delete_owner(foo_hash, Opts, Data, true),
+ ?line verify_etsmem(EtsMem),
+ ?line evil_delete_owner(foo_tree, [ordered_set | Opts], Data, false),
+ ?line verify_etsmem(EtsMem),
+ ?line TabA = evil_delete_not_owner(foo_hash, Opts, Data, false),
+ ?line verify_etsmem(EtsMem),
+ ?line TabB = evil_delete_not_owner(foo_hash, Opts, Data, true),
+ ?line verify_etsmem(EtsMem),
+ ?line TabC = evil_delete_not_owner(foo_tree, [ordered_set | Opts], Data, false),
+ ?line verify_etsmem(EtsMem),
+ ?line lists:foreach(fun(T) -> undefined = ets:info(T) end,
+ [TabA,TabB,TabC]).
+
+evil_delete_not_owner(Name, Flags, Data, Fix) ->
+ io:format("Not owner: ~p, fix = ~p", [Name,Fix]),
+ ?line Tab = ets:new(Name, [public|Flags]),
+ ?line ets:insert(Tab, Data),
+ case Fix of
+ false -> ok;
+ true ->
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data)
+ end,
+ ?line Pid = my_spawn(fun() ->
+ P = my_spawn_link(
+ fun() ->
+ receive kill -> ok end,
+ erlang:yield(),
+ exit(kill_linked_processes_now)
+ end),
+ erlang:yield(),
+ P ! kill,
+ true = ets:delete(Tab)
+ end),
+ ?line Ref = erlang:monitor(process, Pid),
+ ?line receive {'DOWN',Ref,_,_,_} -> ok end,
+ Tab.
+
+evil_delete_owner(Name, Flags, Data, Fix) ->
+ ?line Fun = fun() ->
+ ?line Tab = ets:new(Name, [public|Flags]),
+ ?line ets:insert(Tab, Data),
+ case Fix of
+ false -> ok;
+ true ->
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line lists:foreach(fun({K,_}) ->
+ ets:delete(Tab, K)
+ end, Data)
+ end,
+ erlang:yield(),
+ my_spawn_link(fun() ->
+ erlang:yield(),
+ exit(kill_linked_processes_now)
+ end),
+ true = ets:delete(Tab)
+ end,
+ ?line Pid = my_spawn(Fun),
+ ?line Ref = erlang:monitor(process, Pid),
+ ?line receive {'DOWN',Ref,_,_,_} -> ok end.
+
+
+exit_large_table_owner(doc) ->
+ [];
+exit_large_table_owner(suite) ->
+ [];
+exit_large_table_owner(Config) when is_list(Config) ->
+ ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(fun(Opts) -> exit_large_table_owner_do(Opts,Data,Config) end),
+ ?line verify_etsmem(EtsMem).
+
+exit_large_table_owner_do(Opts,Data,Config) ->
+ ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], true, 1, 1),
+ ?line verify_rescheduling_exit(Config, Data, Opts, false, 1, 1).
+
+exit_many_large_table_owner(doc) -> [];
+exit_many_large_table_owner(suite) -> [];
+exit_many_large_table_owner(Config) when is_list(Config) ->
+ ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(fun(Opts) -> exit_many_large_table_owner_do(Opts,Data,Config) end),
+ ?line verify_etsmem(EtsMem).
+
+exit_many_large_table_owner_do(Opts,Data,Config) ->
+ ?line verify_rescheduling_exit(Config, Data, Opts, true, 1, 4),
+ ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], false, 1, 4).
+
+exit_many_tables_owner(doc) -> [];
+exit_many_tables_owner(suite) -> [];
+exit_many_tables_owner(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line verify_rescheduling_exit(Config, [], [named_table], false, 1000, 1),
+ ?line verify_rescheduling_exit(Config, [], [named_table,{write_concurrency,true}], false, 1000, 1),
+ ?line verify_etsmem(EtsMem).
+
+exit_many_many_tables_owner(doc) -> [];
+exit_many_many_tables_owner(suite) -> [];
+exit_many_many_tables_owner(Config) when is_list(Config) ->
+ ?line Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 50)],
+ repeat_for_opts(fun(Opts) -> exit_many_many_tables_owner_do(Opts,Data,Config) end).
+
+exit_many_many_tables_owner_do(Opts,Data,Config) ->
+ ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], true, 200, 5),
+ ?line verify_rescheduling_exit(Config, Data, Opts, false, 200, 5),
+ ?line wait_for_test_procs(),
+ ?line EtsMem = etsmem(),
+ ?line verify_rescheduling_exit(Config, Data, Opts, true, 200, 5),
+ ?line verify_rescheduling_exit(Config, Data, [named_table | Opts], false, 200, 5),
+ ?line verify_etsmem(EtsMem).
+
+
+count_exit_sched(TP) ->
+ receive
+ {trace, TP, in_exiting, 0} ->
+ count_exit_sched_out(TP, 1);
+ {trace, TP, out_exiting, 0} ->
+ count_exit_sched_in(TP, 1);
+ {trace, TP, out_exited, 0} ->
+ 0
+ end.
+
+count_exit_sched_in(TP, N) ->
+ receive
+ {trace, TP, in_exiting, 0} ->
+ count_exit_sched_out(TP, N);
+ {trace, TP, _, _} = Msg ->
+ exit({unexpected_trace_msg, Msg})
+ end.
+
+count_exit_sched_out(TP, N) ->
+ receive
+ {trace, TP, out_exiting, 0} ->
+ count_exit_sched_in(TP, N+1);
+ {trace, TP, out_exited, 0} ->
+ N;
+ {trace, TP, _, _} = Msg ->
+ exit({unexpected_trace_msg, Msg})
+ end.
+
+vre_fix_tables(Tab) ->
+ Parent = self(),
+ Go = make_ref(),
+ my_spawn_link(fun () ->
+ true = ets:safe_fixtable(Tab, true),
+ Parent ! Go,
+ receive infinity -> ok end
+ end),
+ receive Go -> ok end,
+ ok.
+
+verify_rescheduling_exit(Config, Data, Flags, Fix, NOTabs, NOProcs) ->
+ ?line NoFix = 5,
+ ?line TestCase = atom_to_list(?config(test_case, Config)),
+ ?line Parent = self(),
+ ?line KillMe = make_ref(),
+ ?line PFun =
+ fun () ->
+ repeat(
+ fun () ->
+ {A, B, C} = now(),
+ ?line Name = list_to_atom(
+ TestCase
+ ++ "-" ++ integer_to_list(A)
+ ++ "-" ++ integer_to_list(B)
+ ++ "-" ++ integer_to_list(C)),
+ Tab = ets:new(Name, Flags),
+ ets:insert(Tab, Data),
+ case Fix of
+ false -> ok;
+ true ->
+ lists:foreach(fun (_) ->
+ vre_fix_tables(Tab)
+ end,
+ lists:seq(1,NoFix)),
+ lists:foreach(fun({K,_}) ->
+ ets:delete(Tab, K)
+ end,
+ Data)
+ end
+ end,
+ NOTabs),
+ Parent ! {KillMe, self()},
+ receive after infinity -> ok end
+ end,
+ ?line TPs = lists:map(fun (_) ->
+ ?line TP = my_spawn_link(PFun),
+ ?line 1 = erlang:trace(TP, true, [exiting]),
+ TP
+ end,
+ lists:seq(1, NOProcs)),
+ ?line lists:foreach(fun (TP) ->
+ receive {KillMe, TP} -> ok end
+ end,
+ TPs),
+ ?line LPs = start_loopers(erlang:system_info(schedulers),
+ normal,
+ fun (_) ->
+ erlang:yield()
+ end,
+ ok),
+ ?line lists:foreach(fun (TP) ->
+ ?line unlink(TP),
+ ?line exit(TP, bang)
+ end,
+ TPs),
+ ?line lists:foreach(fun (TP) ->
+ ?line XScheds = count_exit_sched(TP),
+ ?line ?t:format("~p XScheds=~p~n",
+ [TP, XScheds]),
+ ?line true = XScheds >= 5
+ end,
+ TPs),
+ ?line stop_loopers(LPs),
+ ?line ok.
+
+
+
+table_leak(doc) ->
+ "Make sure that slots for ets tables are cleared properly.";
+table_leak(Config) when is_list(Config) ->
+ repeat_for_opts(fun(Opts) -> table_leak_1(Opts,20000) end).
+
+table_leak_1(_,0) -> ok;
+table_leak_1(Opts,N) ->
+ ?line T = ets:new(fooflarf, Opts),
+ ?line true = ets:delete(T),
+ table_leak_1(Opts,N-1).
+
+baddelete(doc) ->
+ ["Check proper return values for illegal delete operations."];
+baddelete(suite) -> [];
+baddelete(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line {'EXIT',{badarg,_}} = (catch ets:delete(foo)),
+ ?line Tab = ets:new(foo,[]),
+ ?line true = ets:delete(Tab),
+ ?line {'EXIT',{badarg,_}} = (catch ets:delete(Tab)),
+ ?line verify_etsmem(EtsMem).
+
+match_delete(doc) ->
+ ["Check that match_delete works. Also tests tab2list function."];
+match_delete(suite) -> [];
+match_delete(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ repeat_for_opts(match_delete_do,[write_concurrency,all_types]),
+ ?line verify_etsmem(EtsMem).
+
+match_delete_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(kad,Opts),
+ ?line fill_tab(Tab,foo),
+ ?line ets:insert(Tab,{{c,key},bar}),
+ ?line _ = ets:match_delete(Tab,{'_',foo}),
+ ?line [{{c,key},bar}] = ets:tab2list(Tab),
+ ?line _ = ets:match_delete(Tab,'_'),
+ ?line [] = ets:tab2list(Tab),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+match_delete3(doc) ->
+ ["OTP-3005: check match_delete with constant argument."];
+match_delete3(suite) -> [];
+match_delete3(Config) when is_list(Config) ->
+ repeat_for_opts(match_delete3_do).
+
+match_delete3_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ T = make_table(test,
+ [duplicate_bag | Opts],
+ [{aa,17},
+ {cA,1000},
+ {cA,17},
+ {cA,1000},
+ {aa,17}]),
+ %% 'aa' and 'cA' have the same hash value in the current
+ %% implementation. This causes the aa's to precede the cA's, to make
+ %% the test more interesting.
+ [{cA,1000},{cA,1000}] = ets:match_object(T, {'_', 1000}),
+ ets:match_delete(T, {cA,1000}),
+ [] = ets:match_object(T, {'_', 1000}),
+ ets:delete(T),
+ ?line verify_etsmem(EtsMem).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+firstnext(doc) -> ["Tests ets:first/1 & ets:next/2."];
+firstnext(suite) -> [];
+firstnext(Config) when is_list(Config) ->
+ repeat_for_opts(firstnext_do).
+
+firstnext_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line [] = firstnext_collect(Tab,ets:first(Tab),[]),
+ ?line fill_tab(Tab,foo),
+ ?line Len = length(ets:tab2list(Tab)),
+ ?line Len = length(firstnext_collect(Tab,ets:first(Tab),[])),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+firstnext_collect(_Tab,'$end_of_table',List) ->
+ ?line List;
+firstnext_collect(Tab,Key,List) ->
+ ?line firstnext_collect(Tab,ets:next(Tab,Key),[Key|List]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+firstnext_concurrent(doc) -> "Tests ets:first/1 & ets:next/2.";
+firstnext_concurrent(Config) when is_list(Config) ->
+ register(master, self()),
+ ets_init(?MODULE, 20),
+ [dynamic_go() || _ <- lists:seq(1, 2)],
+ receive
+ after 5000 -> ok
+ end.
+
+ets_init(Tab, N) ->
+ ets:new(Tab, [named_table,public,ordered_set]),
+ cycle(Tab, lists:seq(1,N+1)).
+
+cycle(_Tab, [H|T]) when H > length(T)-> ok;
+cycle(Tab, L) ->
+ ets:insert(Tab,list_to_tuple(L)),
+ cycle(Tab, tl(L)++[hd(L)]).
+
+dynamic_go() -> spawn_link(fun dynamic_init/0).
+
+dynamic_init() -> [dyn_lookup(?MODULE) || _ <- lists:seq(1, 10)].
+
+dyn_lookup(T) -> dyn_lookup(T, ets:first(T)).
+
+dyn_lookup(_T, '$end_of_table') -> [];
+dyn_lookup(T, K) ->
+ NextKey=ets:next(T,K),
+ case ets:next(T,K) of
+ NextKey ->
+ dyn_lookup(T, NextKey);
+ NK ->
+ io:fwrite("hmmm... ~p =/= ~p~n", [NextKey,NK]),
+ exit(failed)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+slot(suite) -> [];
+slot(Config) when is_list(Config) ->
+ repeat_for_opts(slot_do).
+
+slot_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line fill_tab(Tab,foo),
+ ?line Elts = ets:info(Tab,size),
+ ?line Elts = slot_loop(Tab,0,0),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+slot_loop(Tab,SlotNo,EltsSoFar) ->
+ ?line case ets:slot(Tab,SlotNo) of
+ '$end_of_table' ->
+ ?line {'EXIT',{badarg,_}} =
+ (catch ets:slot(Tab,SlotNo+1)),
+ ?line EltsSoFar;
+ Elts ->
+ ?line slot_loop(Tab,SlotNo+1,EltsSoFar+length(Elts))
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+match(suite) -> [match1, match2, match_object, match_object2].
+
+match1(suite) -> [];
+match1(Config) when is_list(Config) ->
+ repeat_for_opts(match1_do).
+
+match1_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line fill_tab(Tab,foo),
+ ?line [] = ets:match(Tab,{}),
+ ?line ets:insert(Tab,{{one,4},4}),
+ ?line ets:insert(Tab,{{one,5},5}),
+ ?line ets:insert(Tab,{{two,4},4}),
+ ?line ets:insert(Tab,{{two,5},6}),
+ ?line case ets:match(Tab,{{one,'_'},'$0'}) of
+ [[4],[5]] -> ok;
+ [[5],[4]] -> ok
+ end,
+ ?line case ets:match(Tab,{{two,'$1'},'$0'}) of
+ [[4,4],[6,5]] -> ok;
+ [[6,5],[4,4]] -> ok
+ end,
+ ?line case ets:match(Tab,{{two,'$9'},'$4'}) of
+ [[4,4],[6,5]] -> ok;
+ [[6,5],[4,4]] -> ok
+ end,
+ ?line case ets:match(Tab,{{two,'$9'},'$22'}) of
+ [[4,4],[5,6]] -> ok;
+ [[5,6],[4,4]] -> ok
+ end,
+ ?line [[4]] = ets:match(Tab,{{two,'$0'},'$0'}),
+ ?line Len = length(ets:match(Tab,'$0')),
+ ?line Len = length(ets:match(Tab,'_')),
+ ?line if Len > 4 -> ok end,
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+match2(doc) -> ["Tests match with specified keypos bag table."];
+match2(suite) -> [];
+match2(Config) when is_list(Config) ->
+ repeat_for_opts(match2_do).
+
+match2_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = make_table(foobar,
+ [bag, named_table, {keypos, 2} | Opts],
+ [{value1, key1},
+ {value2_1, key2},
+ {value2_2, key2},
+ {value3_1, key3},
+ {value3_2, key3},
+ {value2_1, key2_wannabe}]),
+ ?line case length(ets:match(Tab, '$1')) of
+ 6 -> ok;
+ _ -> ?t:fail("Length of matched list is wrong.")
+ end,
+ ?line [[value3_1],[value3_2]] = ets:match(Tab, {'$1', key3}),
+ ?line [[key1]] = ets:match(Tab, {value1, '$1'}),
+ ?line [[key2_wannabe],[key2]] = ets:match(Tab, {value2_1, '$2'}),
+ ?line [] = ets:match(Tab,{'$1',nosuchkey}),
+ ?line [] = ets:match(Tab,{'$1',kgY2}), % same hash as key2
+ ?line [] = ets:match(Tab,{nosuchvalue,'$1'}),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+match_object(doc) -> ["Some ets:match_object test."];
+match_object(suite) -> [];
+match_object(Config) when is_list(Config) ->
+ repeat_for_opts(match_object_do).
+
+match_object_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foobar, Opts),
+ ?line fill_tab(Tab, foo),
+ ?line ets:insert(Tab, {{one, 4}, 4}),
+ ?line ets:insert(Tab,{{one,5},5}),
+ ?line ets:insert(Tab,{{two,4},4}),
+ ?line ets:insert(Tab,{{two,5},6}),
+ ?line case ets:match_object(Tab, {{one, '_'}, '$0'}) of
+ [{{one,5},5},{{one,4},4}] -> ok;
+ [{{one,4},4},{{one,5},5}] -> ok;
+ _ -> ?t:fail("ets:match_object() returned something funny.")
+ end,
+ ?line case ets:match_object(Tab, {{two, '$1'}, '$0'}) of
+ [{{two,5},6},{{two,4},4}] -> ok;
+ [{{two,4},4},{{two,5},6}] -> ok;
+ _ -> ?t:fail("ets:match_object() returned something funny.")
+ end,
+ ?line case ets:match_object(Tab, {{two, '$9'}, '$4'}) of
+ [{{two,5},6},{{two,4},4}] -> ok;
+ [{{two,4},4},{{two,5},6}] -> ok;
+ _ -> ?t:fail("ets:match_object() returned something funny.")
+ end,
+ ?line case ets:match_object(Tab, {{two, '$9'}, '$22'}) of
+ [{{two,5},6},{{two,4},4}] -> ok;
+ [{{two,4},4},{{two,5},6}] -> ok;
+ _ -> ?t:fail("ets:match_object() returned something funny.")
+ end,
+ % Check that unsucessful match returns an empty list.
+ ?line [] = ets:match_object(Tab, {{three,'$0'}, '$92'}),
+ % Check that '$0' equals '_'.
+ Len = length(ets:match_object(Tab, '$0')),
+ Len = length(ets:match_object(Tab, '_')),
+ ?line if Len > 4 -> ok end,
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+match_object2(suite) -> [];
+match_object2(doc) -> ["Tests that db_match_object does not generate "
+ "a `badarg' when resuming a search with no "
+ "previous matches."];
+match_object2(Config) when is_list(Config) ->
+ repeat_for_opts(match_object2_do).
+
+match_object2_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo, [bag, {keypos, 2} | Opts]),
+ ?line fill_tab2(Tab, 0, 13005), % match_db_object does 1000
+ % elements per pass, might
+ % change in the future.
+ ?line case catch ets:match_object(Tab, {hej, '$1'}) of
+ {'EXIT', _} ->
+ ets:delete(Tab),
+ ?t:fail("match_object EXIT:ed");
+ [] ->
+ io:format("Nothing matched.");
+ List ->
+ io:format("Matched:~p~n",[List])
+ end,
+ ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+misc(suite) -> [misc1, safe_fixtable, info, dups, tab2list].
+
+tab2list(doc) -> ["Tests tab2list (OTP-3319)"];
+tab2list(suite) -> [];
+tab2list(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = make_table(foo,
+ [ordered_set],
+ [{a,b}, {c,b}, {b,b}, {a,c}]),
+ ?line [{a,c},{b,b},{c,b}] = ets:tab2list(Tab),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+misc1(doc) -> ["Simple general small test. ",
+ "If this fails, ets is in really bad shape."];
+misc1(suite) -> [];
+misc1(Config) when is_list(Config) ->
+ repeat_for_opts(misc1_do).
+
+misc1_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo,Opts),
+ ?line true = lists:member(Tab,ets:all()),
+ ?line ets:delete(Tab),
+ ?line false = lists:member(Tab,ets:all()),
+ ?line case catch ets:delete(Tab) of
+ {'EXIT',_Reason} ->
+ ?line verify_etsmem(EtsMem);
+ true ->
+ ?t:fail("Delete of nonexisting table returned `true'.")
+ end,
+ ok.
+
+safe_fixtable(doc) -> ["Check the safe_fixtable function."];
+safe_fixtable(suite) -> [];
+safe_fixtable(Config) when is_list(Config) ->
+ repeat_for_opts(safe_fixtable_do).
+
+safe_fixtable_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foo, Opts),
+ ?line fill_tab(Tab, foobar),
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line receive after 1 -> ok end,
+ ?line true = ets:safe_fixtable(Tab, false),
+ ?line false = ets:info(Tab,safe_fixed),
+ ?line true = ets:safe_fixtable(Tab, true),
+ Self = self(),
+ ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
+ %% Test that an unjustified 'unfix' is a no-op.
+ {Pid,MRef} = spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end),
+ {'DOWN', MRef, process, Pid, normal} = receive M -> M end,
+ ?line true = ets:info(Tab,fixed),
+ ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
+ %% badarg's
+ ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)),
+ ?line true = ets:info(Tab,fixed),
+ ?line true = ets:safe_fixtable(Tab, false),
+ ?line false = ets:info(Tab,fixed),
+ ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)),
+ ?line false = ets:info(Tab,fixed),
+ ?line ets:delete(Tab),
+ ?line case catch ets:safe_fixtable(Tab, true) of
+ {'EXIT', _Reason} ->
+ ?line verify_etsmem(EtsMem);
+ _ ->
+ ?t:fail("Fixtable on nonexisting table returned `true'")
+ end,
+ ok.
+
+info(doc) -> ["Tests ets:info result for required tuples."];
+info(suite) -> [];
+info(Config) when is_list(Config) ->
+ repeat_for_opts(info_do).
+
+info_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line MeMyselfI=self(),
+ ?line ThisNode=node(),
+ ?line Tab = ets:new(foobar, [{keypos, 2} | Opts]),
+
+ %% Note: ets:info/1 used to return a tuple, but from R11B onwards it
+ %% returns a list.
+ ?line Res = ets:info(Tab),
+ ?line {value, {memory, _Mem}} = lists:keysearch(memory, 1, Res),
+ ?line {value, {owner, MeMyselfI}} = lists:keysearch(owner, 1, Res),
+ ?line {value, {name, foobar}} = lists:keysearch(name, 1, Res),
+ ?line {value, {size, 0}} = lists:keysearch(size, 1, Res),
+ ?line {value, {node, ThisNode}} = lists:keysearch(node, 1, Res),
+ ?line {value, {named_table, false}} = lists:keysearch(named_table, 1, Res),
+ ?line {value, {type, set}} = lists:keysearch(type, 1, Res),
+ ?line {value, {keypos, 2}} = lists:keysearch(keypos, 1, Res),
+ ?line {value, {protection, protected}} =
+ lists:keysearch(protection, 1, Res),
+ ?line true = ets:delete(Tab),
+ ?line undefined = ets:info(non_existing_table_xxyy),
+ ?line undefined = ets:info(non_existing_table_xxyy,type),
+ ?line undefined = ets:info(non_existing_table_xxyy,node),
+ ?line undefined = ets:info(non_existing_table_xxyy,named_table),
+ ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed),
+ ?line verify_etsmem(EtsMem).
+
+dups(doc) -> ["Test various duplicate_bags stuff"];
+dups(suite) -> [];
+dups(Config) when is_list(Config) ->
+ repeat_for_opts(dups_do).
+
+dups_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line T = make_table(funky,
+ [duplicate_bag | Opts],
+ [{1, 2}, {1, 2}]),
+ ?line 2 = length(ets:tab2list(T)),
+ ?line ets:delete(T, 1),
+ ?line [] = ets:lookup(T, 1),
+
+ ?line ets:insert(T, {1, 2, 2}),
+ ?line ets:insert(T, {1, 2, 4}),
+ ?line ets:insert(T, {1, 2, 2}),
+ ?line ets:insert(T, {1, 2, 2}),
+ ?line ets:insert(T, {1, 2, 4}),
+
+ ?line 5 = length(ets:tab2list(T)),
+
+ ?line 5 = length(ets:match(T, {'$1', 2, '$2'})),
+ ?line 3 = length(ets:match(T, {'_', '$1', '$1'})),
+ ?line ets:match_delete(T, {'_', '$1', '$1'}),
+ ?line 0 = length(ets:match(T, {'_', '$1', '$1'})),
+ ?line ets:delete(T),
+ ?line verify_etsmem(EtsMem).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+files(suite) -> [tab2file, tab2file2, tab2file3, tabfile_ext1, tabfile_ext2,
+ tabfile_ext3, tabfile_ext4].
+
+tab2file(doc) -> ["Check the ets:tab2file function on an empty "
+ "ets table."];
+tab2file(suite) -> [];
+tab2file(Config) when is_list(Config) ->
+ %% Write an empty ets table to a file, read back and check properties.
+ ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, set, private,
+ {keypos, 2}]),
+ ?line FName = filename:join([?config(priv_dir, Config),"tab2file_case"]),
+ ?line ok = ets:tab2file(Tab, FName),
+ ?line true = ets:delete(Tab),
+ %
+ ?line EtsMem = etsmem(),
+ ?line {ok, Tab2} = ets:file2tab(FName),
+ ?line private = ets:info(Tab2, protection),
+ ?line true = ets:info(Tab2, named_table),
+ ?line 2 = ets:info(Tab2, keypos),
+ ?line set = ets:info(Tab2, type),
+ ?line true = ets:delete(Tab2),
+ ?line verify_etsmem(EtsMem).
+
+tab2file2(doc) -> ["Check the ets:tab2file function on a ",
+ "filled set type ets table."];
+tab2file2(suite) -> [];
+tab2file2(Config) when is_list(Config) ->
+ %% Try the same on a filled set table.
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, set, private,
+ {keypos, 2}]),
+ ?line FName = filename:join([?config(priv_dir, Config),"tab2file2_case"]),
+ ?line ok = fill_tab2(Tab, 0, 10000), % Fill up the table (grucho mucho!)
+ ?line Len = length(ets:tab2list(Tab)),
+ ?line ok = ets:tab2file(Tab, FName),
+ ?line true = ets:delete(Tab),
+ %
+ ?line {ok, Tab2} = ets:file2tab(FName),
+ ?line private = ets:info(Tab2, protection),
+ ?line true = ets:info(Tab2, named_table),
+ ?line 2 = ets:info(Tab2, keypos),
+ ?line set = ets:info(Tab2, type),
+ ?line Len = length(ets:tab2list(Tab2)),
+ ?line true = ets:delete(Tab2),
+ ?line verify_etsmem(EtsMem).
+
+tab2file3(doc) -> ["Check the ets:tab2file function on a ",
+ "filled bag type ets table."];
+tab2file3(suite) -> [];
+tab2file3(Config) when is_list(Config) ->
+ %% Try the same on a filled bag table.
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(ets_SUITE_foo_tab, [named_table, bag, private,
+ {keypos, 2}]),
+ ?line FName = filename:join([?config(priv_dir, Config),"tab2file3_case"]),
+ ?line ok = fill_tab2(Tab, 0, 10000), % Fill up the table (grucho mucho!)
+ ?line Len = length(ets:tab2list(Tab)),
+ ?line Mem = ets:info(Tab, memory),
+ ?line ok = ets:tab2file(Tab, FName),
+ ?line true = ets:delete(Tab),
+
+ ?line {ok, Tab2} = ets:file2tab(FName),
+ ?line private = ets:info(Tab2, protection),
+ ?line true = ets:info(Tab2, named_table),
+ ?line 2 = ets:info(Tab2, keypos),
+ ?line bag = ets:info(Tab2, type),
+ ?line Len = length(ets:tab2list(Tab2)),
+ ?line Mem = ets:info(Tab2, memory),
+ ?line true = ets:delete(Tab2),
+ ?line verify_etsmem(EtsMem).
+
+-define(test_list, [8,5,4,1,58,125,255, 250, 245, 240, 235,
+ 230, Num rem 255, 255, 125, 130, 135, 140, 145,
+ 150, 134, 12, 54, Val rem 255, 12, 3, 6, 9, 126]).
+-define(big_test_list, [Num rem 256|lists:seq(1, 66)]).
+-define(test_integer, 2846287468+Num).
+-define(test_float, 187263.18236-Val).
+-define(test_atom, some_crazy_atom).
+-define(test_tuple, {just, 'Some', 'Tuple', 1, [list, item], Val+Num}).
+
+%% Insert different datatypes into a ets table.
+fill_tab2(_Tab, _Val, 0) ->
+ ok;
+fill_tab2(Tab, Val, Num) ->
+ ?line Item =
+ case Num rem 10 of
+ 0 -> "String";
+ 1 -> ?line ?test_atom;
+ 2 -> ?line ?test_tuple;
+ 3 -> ?line ?test_integer;
+ 4 -> ?line ?test_float;
+ 5 -> ?line list_to_binary(?test_list); %Heap binary
+ 6 -> ?line list_to_binary(?big_test_list); %Refc binary
+ 7 -> ?line make_sub_binary(?test_list, Num); %Sub binary
+ 8 -> ?line ?test_list;
+ 9 -> ?line fun(X) -> {Tab,Val,X*Num} end
+ end,
+ ?line true=ets:insert(Tab, {Item, Val}),
+ ?line fill_tab2(Tab, Val+1, Num-1),
+ ok.
+
+tabfile_ext1(suite) ->
+ [];
+tabfile_ext1(doc) ->
+ ["Tests verification of tables with object count extended_info"];
+tabfile_ext1(Config) when is_list(Config) ->
+ repeat_for_opts(fun(Opts) -> tabfile_ext1_do(Opts, Config) end).
+
+tabfile_ext1_do(Opts,Config) ->
+ ?line FName = filename:join([?config(priv_dir, Config),"nisse.dat"]),
+ ?line FName2 = filename:join([?config(priv_dir, Config),"countflip.dat"]),
+ L = lists:seq(1,10),
+ T = ets:new(x,Opts),
+ Name = make_ref(),
+ [ets:insert(T,{X,integer_to_list(X)}) || X <- L],
+ ok = ets:tab2file(T,FName,[{extended_info,[object_count]}]),
+ true = lists:sort(ets:tab2list(T)) =:=
+ lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))),
+ true = lists:sort(ets:tab2list(T)) =:=
+ lists:sort(ets:tab2list(
+ element(2,ets:file2tab(FName,[{verify,true}])))),
+ {ok,Name} = disk_log:open([{name,Name},{file,FName}]),
+ {_,[H0|T0]} = disk_log:chunk(Name,start),
+ disk_log:close(Name),
+ LH0=tuple_to_list(H0),
+ {value,{size,N}}=lists:keysearch(size,1,LH0),
+ NewLH0 = lists:keyreplace(size,1,LH0,{size,N-1}),
+ NewH0 = list_to_tuple(NewLH0),
+ NewT0=lists:keydelete(8,1,T0),
+ file:delete(FName2),
+ disk_log:open([{name,Name},{file,FName2},{mode,read_write}]),
+ disk_log:log_terms(Name,[NewH0|NewT0]),
+ disk_log:close(Name),
+ 9 = length(ets:tab2list(element(2,ets:file2tab(FName2)))),
+ {error,invalid_object_count} = ets:file2tab(FName2,[{verify,true}]),
+ {ok, _} = ets:tabfile_info(FName2),
+ {ok, _} = ets:tabfile_info(FName),
+ file:delete(FName),
+ file:delete(FName2),
+ ok.
+
+tabfile_ext2(suite) ->
+ [];
+tabfile_ext2(doc) ->
+ ["Tests verification of tables with md5sum extended_info"];
+tabfile_ext2(Config) when is_list(Config) ->
+ repeat_for_opts(fun(Opts) -> tabfile_ext2_do(Opts,Config) end).
+
+tabfile_ext2_do(Opts,Config) ->
+ ?line FName = filename:join([?config(priv_dir, Config),"olle.dat"]),
+ ?line FName2 = filename:join([?config(priv_dir, Config),"bitflip.dat"]),
+ L = lists:seq(1,10),
+ T = ets:new(x,Opts),
+ Name = make_ref(),
+ [ets:insert(T,{X,integer_to_list(X)}) || X <- L],
+ ok = ets:tab2file(T,FName,[{extended_info,[md5sum]}]),
+ true = lists:sort(ets:tab2list(T)) =:=
+ lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))),
+ true = lists:sort(ets:tab2list(T)) =:=
+ lists:sort(ets:tab2list(
+ element(2,ets:file2tab(FName,[{verify,true}])))),
+ {ok, Name} = disk_log:open([{name,Name},{file,FName}]),
+ {_,[H1|T1]} = disk_log:chunk(Name,start),
+ disk_log:close(Name),
+ NewT1=lists:keyreplace(8,1,T1,{8,"9"}),
+ file:delete(FName2),
+ disk_log:open([{name,Name},{file,FName2},{mode,read_write}]),
+ disk_log:log_terms(Name,[H1|NewT1]),
+ disk_log:close(Name),
+ {value,{8,"9"}} = lists:keysearch(8,1,
+ ets:tab2list(
+ element(2,ets:file2tab(FName2)))),
+ {error,checksum_error} = ets:file2tab(FName2,[{verify,true}]),
+ {value,{extended_info,[md5sum]}} =
+ lists:keysearch(extended_info,1,element(2,ets:tabfile_info(FName2))),
+ {value,{extended_info,[md5sum]}} =
+ lists:keysearch(extended_info,1,element(2,ets:tabfile_info(FName))),
+ file:delete(FName),
+ file:delete(FName2),
+ ok.
+
+tabfile_ext3(suite) ->
+ [];
+tabfile_ext3(doc) ->
+ ["Tests verification of (named) tables without extended info"];
+tabfile_ext3(Config) when is_list(Config) ->
+ ?line FName = filename:join([?config(priv_dir, Config),"namn.dat"]),
+ ?line FName2 = filename:join([?config(priv_dir, Config),"ncountflip.dat"]),
+ L = lists:seq(1,10),
+ Name = make_ref(),
+ ?MODULE = ets:new(?MODULE,[named_table]),
+ [ets:insert(?MODULE,{X,integer_to_list(X)}) || X <- L],
+ ets:tab2file(?MODULE,FName),
+ {error,cannot_create_table} = ets:file2tab(FName),
+ true = ets:delete(?MODULE),
+ {ok,?MODULE} = ets:file2tab(FName),
+ true = ets:delete(?MODULE),
+ disk_log:open([{name,Name},{file,FName}]),
+ {_,[H2|T2]} = disk_log:chunk(Name,start),
+ disk_log:close(Name),
+ NewT2=lists:keydelete(8,1,T2),
+ file:delete(FName2),
+ disk_log:open([{name,Name},{file,FName2},{mode,read_write}]),
+ disk_log:log_terms(Name,[H2|NewT2]),
+ disk_log:close(Name),
+ 9 = length(ets:tab2list(element(2,ets:file2tab(FName2)))),
+ true = ets:delete(?MODULE),
+ {error,invalid_object_count} = ets:file2tab(FName2,[{verify,true}]),
+ {'EXIT',_} = (catch ets:delete(?MODULE)),
+ {ok,_} = ets:tabfile_info(FName2),
+ {ok,_} = ets:tabfile_info(FName),
+ file:delete(FName),
+ file:delete(FName2),
+ ok.
+
+tabfile_ext4(suite) ->
+ [];
+tabfile_ext4(doc) ->
+ ["Tests verification of large table with md5 sum"];
+tabfile_ext4(Config) when is_list(Config) ->
+ ?line FName = filename:join([?config(priv_dir, Config),"bauta.dat"]),
+ LL = lists:seq(1,10000),
+ TL = ets:new(x,[]),
+ Name2 = make_ref(),
+ [ets:insert(TL,{X,integer_to_list(X)}) || X <- LL],
+ ok = ets:tab2file(TL,FName,[{extended_info,[md5sum]}]),
+ {ok, Name2} = disk_log:open([{name, Name2}, {file, FName},
+ {mode, read_only}]),
+ {C,[_|_]} = disk_log:chunk(Name2,start),
+ {_,[_|_]} = disk_log:chunk(Name2,C),
+ disk_log:close(Name2),
+ true = lists:sort(ets:tab2list(TL)) =:=
+ lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))),
+ Res = [
+ begin
+ {ok,FD} = file:open(FName,[binary,read,write]),
+ {ok, Bin} = file:pread(FD,0,1000),
+ <<B1:N/binary,Ch:8,B2/binary>> = Bin,
+ Ch2 = (Ch + 1) rem 255,
+ Bin2 = <<B1/binary,Ch2:8,B2/binary>>,
+ ok = file:pwrite(FD,0,Bin2),
+ ok = file:close(FD),
+ X = case ets:file2tab(FName) of
+ {ok,TL2} ->
+ true = lists:sort(ets:tab2list(TL)) =/=
+ lists:sort(ets:tab2list(TL2));
+ _ ->
+ totally_broken
+ end,
+ {error,Y} = ets:file2tab(FName,[{verify,true}]),
+ ets:tab2file(TL,FName,[{extended_info,[md5sum]}]),
+ {X,Y}
+ end || N <- lists:seq(400,500) ],
+ io:format("~p~n",[Res]),
+ file:delete(FName),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+make_sub_binary(List, Num) when is_list(List) ->
+ N = Num rem 23,
+ Bin = list_to_binary([lists:seq(0, N)|List]),
+ {_,B} = split_binary(Bin, N+1),
+ B.
+
+heavy(suite) -> [heavy_lookup, heavy_lookup_element].
+
+%% Lookup stuff like crazy...
+heavy_lookup(doc) -> ["Performs multiple lookups for every key ",
+ "in a large table."];
+heavy_lookup(suite) -> [];
+heavy_lookup(Config) when is_list(Config) ->
+ repeat_for_opts(heavy_lookup_do).
+
+heavy_lookup_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foobar_table, [set, protected, {keypos, 2} | Opts]),
+ ?line ok = fill_tab2(Tab, 0, 7000),
+ ?line ?t:do_times(50, ?MODULE, do_lookup, [Tab, 6999]),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+do_lookup(_Tab, 0) -> ok;
+do_lookup(Tab, N) ->
+ case ets:lookup(Tab, N) of
+ [] -> ?t:format("Set #~p was reported as empty. Not valid.",
+ [N]),
+ exit('Invalid lookup');
+ _ -> do_lookup(Tab, N-1)
+ end.
+
+heavy_lookup_element(doc) -> ["Performs multiple lookups for ",
+ "every element in a large table."];
+heavy_lookup_element(suite) -> [];
+heavy_lookup_element(Config) when is_list(Config) ->
+ repeat_for_opts(heavy_lookup_element_do).
+
+heavy_lookup_element_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = ets:new(foobar_table, [set, protected, {keypos, 2} | Opts]),
+ ?line ok = fill_tab2(Tab, 0, 7000),
+ case os:type() of
+ vxworks ->
+ ?line ?t:do_times(5, ?MODULE, do_lookup_element,
+ [Tab, 6999, 1]);
+ % lookup ALL elements 5 times.
+ _ ->
+ ?line ?t:do_times(50, ?MODULE, do_lookup_element,
+ [Tab, 6999, 1])
+ % lookup ALL elements 50 times.
+ end,
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+do_lookup_element(_Tab, 0, _) -> ok;
+do_lookup_element(Tab, N, M) ->
+ ?line case catch ets:lookup_element(Tab, N, M) of
+ {'EXIT', {badarg, _}} ->
+ case M of
+ 1 -> ?t:fail("Set #~p reported as empty. Not valid.",
+ [N]),
+ exit('Invalid lookup_element');
+ _ -> ?line do_lookup_element(Tab, N-1, 1)
+ end;
+ _ -> ?line do_lookup_element(Tab, N, M+1)
+ end.
+
+
+fold(suite) -> [foldl_ordered, foldr_ordered,
+ foldl, foldr,
+ fold_empty].
+
+fold_empty(doc) ->
+ [];
+fold_empty(suite) -> [];
+fold_empty(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line Tab = make_table(a, [], []),
+ ?line [] = ets:foldl(fun(_X) -> exit(hej) end, [], Tab),
+ ?line [] = ets:foldr(fun(_X) -> exit(hej) end, [], Tab),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+foldl(doc) ->
+ [];
+foldl(suite) -> [];
+foldl(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line L = [{a,1}, {c,3}, {b,2}],
+ ?line LS = lists:sort(L),
+ ?line Tab = make_table(a, [bag], L),
+ ?line LS = lists:sort(ets:foldl(fun(E,A) -> [E|A] end, [], Tab)),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+foldr(doc) ->
+ [];
+foldr(suite) -> [];
+foldr(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line L = [{a,1}, {c,3}, {b,2}],
+ ?line LS = lists:sort(L),
+ ?line Tab = make_table(a, [bag], L),
+ ?line LS = lists:sort(ets:foldr(fun(E,A) -> [E|A] end, [], Tab)),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+foldl_ordered(doc) ->
+ [];
+foldl_ordered(suite) -> [];
+foldl_ordered(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line L = [{a,1}, {c,3}, {b,2}],
+ ?line LS = lists:sort(L),
+ ?line Tab = make_table(a, [ordered_set], L),
+ ?line LS = lists:reverse(ets:foldl(fun(E,A) -> [E|A] end, [], Tab)),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+foldr_ordered(doc) ->
+ [];
+foldr_ordered(suite) -> [];
+foldr_ordered(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line L = [{a,1}, {c,3}, {b,2}],
+ ?line LS = lists:sort(L),
+ ?line Tab = make_table(a, [ordered_set], L),
+ ?line LS = ets:foldr(fun(E,A) -> [E|A] end, [], Tab),
+ ?line true = ets:delete(Tab),
+ ?line verify_etsmem(EtsMem).
+
+member(suite) ->
+ [];
+member(doc) ->
+ ["Tests ets:member BIF"];
+member(Config) when is_list(Config) ->
+ repeat_for_opts(member_do, [write_concurrency, all_types]).
+
+member_do(Opts) ->
+ ?line EtsMem = etsmem(),
+ ?line T = ets:new(xxx, Opts),
+ ?line false = ets:member(T,hej),
+ ?line E = fun(0,_F)->ok;
+ (N,F) ->
+ ?line ets:insert(T,{N,N rem 10}),
+ F(N-1,F)
+ end,
+ ?line E(10000,E),
+ ?line false = ets:member(T,hej),
+ ?line true = ets:member(T,1),
+ ?line false = ets:member(T,20000),
+ ?line ets:delete(T,5),
+ ?line false = ets:member(T,5),
+ ?line ets:safe_fixtable(T,true),
+ ?line ets:delete(T,6),
+ ?line false = ets:member(T,6),
+ ?line ets:safe_fixtable(T,false),
+ ?line false = ets:member(T,6),
+ ?line ets:delete(T),
+ ?line {'EXIT',{badarg,_}} = (catch ets:member(finnsinte, 23)),
+ ?line {'EXIT',{badarg,_}} = (catch ets:member(T, 23)),
+ ?line verify_etsmem(EtsMem).
+
+
+build_table(L1,L2,Num) ->
+ T = ets:new(xxx, [ordered_set]
+ ),
+ lists:foreach(
+ fun(X1) ->
+ lists:foreach(
+ fun(X2) ->
+ F = fun(FF,N) ->
+ ets:insert(T,{{X1,X2,N},
+ X1, X2, N}),
+ case N of
+ 0 ->
+ ok;
+ _ ->
+ FF(FF,N-1)
+ end
+ end,
+ F(F,Num)
+ end, L2)
+ end, L1),
+ T.
+
+build_table2(L1,L2,Num) ->
+ T = ets:new(xxx, [ordered_set]
+ ),
+ lists:foreach(
+ fun(X1) ->
+ lists:foreach(
+ fun(X2) ->
+ F = fun(FF,N) ->
+ ets:insert(T,{{N,X1,X2},
+ N, X1, X2}),
+ case N of
+ 0 ->
+ ok;
+ _ ->
+ FF(FF,N-1)
+ end
+ end,
+ F(F,Num)
+ end, L2)
+ end, L1),
+ T.
+
+time_match_object(Tab,Match, Res) ->
+ T1 = erlang:now(),
+ Res = ets:match_object(Tab,Match),
+ T2 = erlang:now(),
+ nowdiff(T1,T2).
+
+time_match(Tab,Match) ->
+ T1 = erlang:now(),
+ ets:match(Tab,Match),
+ T2 = erlang:now(),
+ nowdiff(T1,T2).
+
+seventyfive_percent_success(_,S,Fa,0) ->
+ true = (S > ((S + Fa) * 0.75));
+
+seventyfive_percent_success({M,F,A},S,Fa,N) ->
+ case (catch apply(M,F,A)) of
+ {'EXIT', _} ->
+ seventyfive_percent_success({M,F,A},S,Fa+1,N-1);
+ _ ->
+ seventyfive_percent_success({M,F,A},S+1,Fa,N-1)
+ end.
+
+fifty_percent_success(_,S,Fa,0) ->
+ true = (S > ((S + Fa) * 0.5));
+
+fifty_percent_success({M,F,A},S,Fa,N) ->
+ case (catch apply(M,F,A)) of
+ {'EXIT', _} ->
+ fifty_percent_success({M,F,A},S,Fa+1,N-1);
+ _ ->
+ fifty_percent_success({M,F,A},S+1,Fa,N-1)
+ end.
+
+
+nowtonumber({Mega, Secs, Milli}) ->
+ Milli + Secs * 1000000 + Mega * 1000000000000.
+nowdiff(T1,T2) ->
+ nowtonumber(T2) - nowtonumber(T1).
+
+create_random_string(0) ->
+ [];
+
+create_random_string(OfLength) ->
+ C = case random:uniform(2) of
+ 1 ->
+ (random:uniform($Z - $A + 1) - 1) + $A;
+ _ ->
+ (random:uniform($z - $a + 1) - 1) + $a
+ end,
+ [C | create_random_string(OfLength - 1)].
+
+
+create_random_tuple(OfLength) ->
+ list_to_tuple(lists:map(fun(X) ->
+ list_to_atom([X])
+ end,create_random_string(OfLength))).
+
+create_partly_bound_tuple(OfLength) ->
+ case random:uniform(2) of
+ 1 ->
+ create_partly_bound_tuple1(OfLength);
+ _ ->
+ create_partly_bound_tuple3(OfLength)
+ end.
+
+create_partly_bound_tuple1(OfLength) ->
+ T0 = create_random_tuple(OfLength),
+ I = random:uniform(OfLength),
+ setelement(I,T0,'$1').
+
+
+set_n_random_elements(T0,0,_,_) ->
+ T0;
+set_n_random_elements(T0,N,OfLength,GenFun) ->
+ I = random:uniform(OfLength),
+ What = GenFun(I),
+ case element(I,T0) of
+ What ->
+ set_n_random_elements(T0,N,OfLength,GenFun);
+ _Else ->
+ set_n_random_elements(setelement(I,T0,What),
+ N-1,OfLength,GenFun)
+ end.
+
+make_dollar_atom(I) ->
+ list_to_atom([$$] ++ integer_to_list(I)).
+create_partly_bound_tuple2(OfLength) ->
+ T0 = create_random_tuple(OfLength),
+ I = random:uniform(OfLength - 1),
+ set_n_random_elements(T0,I,OfLength,fun make_dollar_atom/1).
+
+create_partly_bound_tuple3(OfLength) ->
+ T0 = create_random_tuple(OfLength),
+ I = random:uniform(OfLength - 1),
+ set_n_random_elements(T0,I,OfLength,fun(_) -> '_' end).
+
+do_n_times(_,0) ->
+ ok;
+do_n_times(Fun,N) ->
+ Fun(),
+ case N rem 1000 of
+ 0 ->
+ io:format(".");
+ _ ->
+ ok
+ end,
+ do_n_times(Fun,N-1).
+
+make_table(Name, Options, Elements) ->
+ T = ets:new(Name, Options),
+ lists:foreach(fun(E) -> ets:insert(T, E) end, Elements),
+ T.
+filltabint(Tab,0) ->
+ Tab;
+filltabint(Tab,N) ->
+ ets:insert(Tab,{N,integer_to_list(N)}),
+ filltabint(Tab,N-1).
+filltabint2(Tab,0) ->
+ Tab;
+filltabint2(Tab,N) ->
+ ets:insert(Tab,{N + N rem 2,integer_to_list(N)}),
+ filltabint2(Tab,N-1).
+filltabint3(Tab,0) ->
+ Tab;
+filltabint3(Tab,N) ->
+ ets:insert(Tab,{N + N rem 2,integer_to_list(N + N rem 2)}),
+ filltabint3(Tab,N-1).
+xfilltabint(Tab,N) ->
+ case ets:info(Tab,type) of
+ bag ->
+ filltabint2(Tab,N);
+ duplicate_bag ->
+ ets:select_delete(Tab,[{'_',[],[true]}]),
+ filltabint3(Tab,N);
+ _ ->
+ filltabint(Tab,N)
+ end.
+
+
+filltabstr(Tab,N) ->
+ filltabstr(Tab,0,N).
+filltabstr(Tab,N,N) ->
+ Tab;
+filltabstr(Tab,Floor,N) when N > Floor ->
+ ets:insert(Tab,{integer_to_list(N),N}),
+ filltabstr(Tab,Floor,N-1).
+
+filltabstr2(Tab,0) ->
+ Tab;
+filltabstr2(Tab,N) ->
+ ets:insert(Tab,{integer_to_list(N),N}),
+ ets:insert(Tab,{integer_to_list(N),N+1}),
+ filltabstr2(Tab,N-1).
+filltabstr3(Tab,0) ->
+ Tab;
+filltabstr3(Tab,N) ->
+ ets:insert(Tab,{integer_to_list(N),N}),
+ ets:insert(Tab,{integer_to_list(N),N}),
+ filltabstr3(Tab,N-1).
+xfilltabstr(Tab,N) ->
+ case ets:info(Tab,type) of
+ bag ->
+ filltabstr2(Tab,N);
+ duplicate_bag ->
+ ets:select_delete(Tab,[{'_',[],[true]}]),
+ filltabstr3(Tab,N);
+ _ ->
+ filltabstr(Tab,N)
+ end.
+
+fill_sets_int(N) ->
+ fill_sets_int(N,[]).
+fill_sets_int(N,Opts) ->
+ Tab1 = ets:new(xxx, [ordered_set|Opts]),
+ filltabint(Tab1,N),
+ Tab2 = ets:new(xxx, [set|Opts]),
+ filltabint(Tab2,N),
+ Tab3 = ets:new(xxx, [bag|Opts]),
+ filltabint2(Tab3,N),
+ Tab4 = ets:new(xxx, [duplicate_bag|Opts]),
+ filltabint3(Tab4,N),
+ [Tab1,Tab2,Tab3,Tab4].
+
+check_fun(_Tab,_Fun,'$end_of_table') ->
+ ok;
+check_fun(Tab,Fun,Item) ->
+ lists:foreach(fun(Obj) ->
+ true = Fun(Obj)
+ end,
+ ets:lookup(Tab,Item)),
+ check_fun(Tab,Fun,ets:next(Tab,Item)).
+
+check(Tab,Fun,N) ->
+ N = ets:info(Tab, size),
+ check_fun(Tab,Fun,ets:first(Tab)).
+
+
+
+del_one_by_one_set(T,N,N) ->
+ 0 = ets:info(T,size),
+ ok;
+del_one_by_one_set(T,From,To) ->
+ N = ets:info(T,size),
+ ets:delete_object(T,{From, integer_to_list(From)}),
+ N = (ets:info(T,size) + 1),
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ del_one_by_one_set(T,Next,To).
+
+del_one_by_one_bag(T,N,N) ->
+ 0 = ets:info(T,size),
+ ok;
+del_one_by_one_bag(T,From,To) ->
+ N = ets:info(T,size),
+ ets:delete_object(T,{From + From rem 2, integer_to_list(From)}),
+ N = (ets:info(T,size) + 1),
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ del_one_by_one_bag(T,Next,To).
+
+
+del_one_by_one_dbag_1(T,N,N) ->
+ 0 = ets:info(T,size),
+ ok;
+del_one_by_one_dbag_1(T,From,To) ->
+ N = ets:info(T,size),
+ ets:delete_object(T,{From, integer_to_list(From)}),
+ case From rem 2 of
+ 0 ->
+ N = (ets:info(T,size) + 2);
+ 1 ->
+ N = ets:info(T,size)
+ end,
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ del_one_by_one_dbag_1(T,Next,To).
+
+del_one_by_one_dbag_2(T,N,N) ->
+ 0 = ets:info(T,size),
+ ok;
+del_one_by_one_dbag_2(T,From,To) ->
+ N = ets:info(T,size),
+ ets:delete_object(T,{From, integer_to_list(From)}),
+ case From rem 2 of
+ 0 ->
+ N = (ets:info(T,size) + 3);
+ 1 ->
+ N = (ets:info(T,size) + 1)
+ end,
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ del_one_by_one_dbag_2(T,Next,To).
+
+del_one_by_one_dbag_3(T,N,N) ->
+ 0 = ets:info(T,size),
+ ok;
+del_one_by_one_dbag_3(T,From,To) ->
+ N = ets:info(T,size),
+ Obj = {From + From rem 2, integer_to_list(From)},
+ ets:delete_object(T,Obj),
+ case From rem 2 of
+ 0 ->
+ N = (ets:info(T,size) + 2);
+ 1 ->
+ N = (ets:info(T,size) + 1),
+ Obj2 = {From, integer_to_list(From)},
+ ets:delete_object(T,Obj2),
+ N = (ets:info(T,size) + 2)
+ end,
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ del_one_by_one_dbag_3(T,Next,To).
+
+
+successive_delete(Table,From,To,Type) ->
+ successive_delete(Table,From,To,Type,ets:info(Table,type)).
+
+successive_delete(_Table,N,N,_,_) ->
+ ok;
+successive_delete(Table,From,To,Type,TType) ->
+ MS = case Type of
+ bound ->
+ [{{From,'_'},[],[true]}];
+ unbound ->
+ [{{'$1','_'},[],[{'==', '$1', From}]}]
+ end,
+ case TType of
+ X when X == bag; X == duplicate_bag ->
+ %erlang:display(From),
+ case From rem 2 of
+ 0 ->
+ 2 = ets:select_delete(Table,MS);
+ _ ->
+ 0 = ets:select_delete(Table,MS)
+ end;
+ _ ->
+ 1 = ets:select_delete(Table,MS)
+ end,
+ Next = if
+ From < To ->
+ From + 1;
+ true ->
+ From - 1
+ end,
+ successive_delete(Table, Next, To, Type,TType).
+
+gen_dets_filename(Config,N) ->
+ filename:join(?config(priv_dir,Config),
+ "testdets_" ++ integer_to_list(N) ++ ".dets").
+
+otp_6842_select_1000(Config) when is_list(Config) ->
+ ?line Tab = ets:new(xxx,[ordered_set]),
+ ?line [ets:insert(Tab,{X,X}) || X <- lists:seq(1,10000)],
+ ?line AllTrue = lists:duplicate(10,true),
+ ?line AllTrue =
+ [ length(
+ element(1,
+ ets:select(Tab,[{'_',[],['$_']}],X*1000))) =:=
+ X*1000 || X <- lists:seq(1,10) ],
+ ?line Sequences = [[1000,1000,1000,1000,1000,1000,1000,1000,1000,1000],
+ [2000,2000,2000,2000,2000],
+ [3000,3000,3000,1000],
+ [4000,4000,2000],
+ [5000,5000],
+ [6000,4000],
+ [7000,3000],
+ [8000,2000],
+ [9000,1000],
+ [10000]],
+ ?line AllTrue = [ check_seq(Tab, ets:select(Tab,[{'_',[],['$_']}],hd(L)),L) ||
+ L <- Sequences ],
+ ?line ets:delete(Tab),
+ ok.
+
+check_seq(_,'$end_of_table',[]) ->
+ true;
+check_seq(Tab,{L,C},[H|T]) when length(L) =:= H ->
+ check_seq(Tab, ets:select(C),T);
+check_seq(A,B,C) ->
+ erlang:display({A,B,C}),
+ false.
+
+otp_6338(Config) when is_list(Config) ->
+ L = binary_to_term(<<131,108,0,0,0,2,104,2,108,0,0,0,2,103,100,0,19,112,112,98,49,95,98,115,49,50,64,98,108,97,100,101,95,48,95,53,0,0,33,50,0,0,0,4,1,98,0,0,23,226,106,100,0,4,101,120,105,116,104,2,108,0,0,0,2,104,2,100,0,3,115,98,109,100,0,19,112,112,98,50,95,98,115,49,50,64,98,108,97,100,101,95,48,95,56,98,0,0,18,231,106,100,0,4,114,101,99,118,106>>),
+ T = ets:new(xxx,[ordered_set]),
+ lists:foreach(fun(X) -> ets:insert(T,X) end,L),
+ [[4839,recv]] = ets:match(T,{[{sbm,ppb2_bs12@blade_0_8},'$1'],'$2'}),
+ ets:delete(T).
+
+%% Elements could come in the wrong order in a bag if a rehash occurred.
+otp_5340(Config) when is_list(Config) ->
+ repeat_for_opts(otp_5340_do).
+
+otp_5340_do(Opts) ->
+ N = 3000,
+ T = ets:new(otp_5340, [bag,public | Opts]),
+ Ids = [1,2,3,4,5],
+ [w(T, N, Id) || Id <- Ids],
+ verify(T, Ids),
+ ets:delete(T).
+
+w(_,0, _) -> ok;
+w(T,N, Id) ->
+ ets:insert(T, {N, Id}),
+ w(T,N-1,Id).
+
+verify(T, Ids) ->
+ List = my_tab_to_list(T),
+ Errors = lists:filter(fun(Bucket) ->
+ verify2(Bucket, Ids)
+ end, List),
+ case Errors of
+ [] ->
+ ok;
+ _ ->
+ io:format("Failed:\n~p\n", [Errors]),
+ ?t:fail()
+ end.
+
+verify2([{_N,Id}|RL], [Id|R]) ->
+ verify2(RL,R);
+verify2([],[]) -> false;
+verify2(_Err, _) ->
+ true.
+
+otp_7665(doc) -> ["delete_object followed by delete on fixed bag failed to delete objects."];
+otp_7665(suite) -> [];
+otp_7665(Config) when is_list(Config) ->
+ repeat_for_opts(otp_7665_do).
+
+otp_7665_do(Opts) ->
+ Tab = ets:new(otp_7665,[bag | Opts]),
+ Min = 0,
+ Max = 10,
+ lists:foreach(fun(N)-> otp_7665_act(Tab,Min,Max,N) end,
+ lists:seq(Min,Max)),
+ ?line true = ets:delete(Tab).
+
+otp_7665_act(Tab,Min,Max,DelNr) ->
+ List1 = [{key,N} || N <- lists:seq(Min,Max)],
+ ?line true = ets:insert(Tab, List1),
+ ?line true = ets:safe_fixtable(Tab, true),
+ ?line true = ets:delete_object(Tab, {key,DelNr}),
+ List2 = lists:delete({key,DelNr}, List1),
+
+ %% Now verify that we find all remaining objects
+ ?line List2 = ets:lookup(Tab,key),
+ ?line EList2 = lists:map(fun({key,N})-> N end,
+ List2),
+ ?line EList2 = ets:lookup_element(Tab,key,2),
+ ?line true = ets:delete(Tab, key),
+ ?line [] = ets:lookup(Tab, key),
+ ?line true = ets:safe_fixtable(Tab, false),
+ ok.
+
+%% Whitebox testing of meta name table hashing.
+meta_wb(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ ?line erts_debug:set_internal_state(available_internal_state, true),
+ try
+ repeat_for_opts(meta_wb_do)
+ after
+ erts_debug:set_internal_state(available_internal_state, false)
+ end,
+ ?line verify_etsmem(EtsMem).
+
+
+meta_wb_do(Opts) ->
+ %% Do random new/delete/rename of colliding named tables
+ Names = [pioneer | colliding_names(pioneer)],
+ Len = length(Names),
+ OpFuns = {fun meta_wb_new/4, fun meta_wb_delete/4, fun meta_wb_rename/4},
+
+ io:format("Colliding names = ~p\n",[Names]),
+ F = fun(0,_,_) -> ok;
+ (N,Tabs,Me) -> Name1 = lists:nth(random:uniform(Len),Names),
+ Name2 = lists:nth(random:uniform(Len),Names),
+ Op = element(random:uniform(3),OpFuns),
+ NTabs = Op(Name1, Name2, Tabs, Opts),
+ Me(N-1,NTabs,Me)
+ end,
+ F(Len*100, [], F),
+
+ % cleanup
+ lists:foreach(fun(Name)->catch ets:delete(Name) end,
+ Names).
+
+meta_wb_new(Name, _, Tabs, Opts) ->
+ case (catch ets:new(Name,[named_table|Opts])) of
+ Name ->
+ ?line false = lists:member(Name, Tabs),
+ [Name | Tabs];
+ {'EXIT',{badarg,_}} ->
+ ?line true = lists:member(Name, Tabs),
+ Tabs
+ end.
+meta_wb_delete(Name, _, Tabs, _) ->
+ case (catch ets:delete(Name)) of
+ true ->
+ ?line true = lists:member(Name, Tabs),
+ lists:delete(Name, Tabs);
+ {'EXIT',{badarg,_}} ->
+ ?line false = lists:member(Name, Tabs),
+ Tabs
+ end.
+meta_wb_rename(Old, New, Tabs, _) ->
+ case (catch ets:rename(Old,New)) of
+ New ->
+ ?line true = lists:member(Old, Tabs)
+ andalso not lists:member(New, Tabs),
+ [New | lists:delete(Old, Tabs)];
+ {'EXIT',{badarg,_}} ->
+ ?line true = not lists:member(Old, Tabs)
+ orelse lists:member(New,Tabs),
+ Tabs
+ end.
+
+
+colliding_names(Name) ->
+ erts_debug:set_internal_state(colliding_names, {Name,5}).
+
+
+%% OTP_6913: Grow and shrink.
+
+grow_shrink(Config) when is_list(Config) ->
+ ?line EtsMem = etsmem(),
+ grow_shrink_0(lists:seq(3071, 5000), EtsMem).
+
+grow_shrink_0([N|Ns], EtsMem) ->
+ ?line grow_shrink_1(N, [set]),
+ ?line grow_shrink_1(N, [ordered_set]),
+ ?line verify_etsmem(EtsMem),
+ grow_shrink_0(Ns, EtsMem);
+grow_shrink_0([], _) -> ok.
+
+grow_shrink_1(N, Flags) ->
+ ?line T = ets:new(a, Flags),
+ ?line grow_shrink_2(N, N, T),
+ ?line ets:delete(T).
+
+grow_shrink_2(0, Orig, T) ->
+ List = [{I,a} || I <- lists:seq(1, Orig)],
+ List = lists:sort(ets:tab2list(T)),
+ grow_shrink_3(Orig, T);
+grow_shrink_2(N, Orig, T) ->
+ true = ets:insert(T, {N,a}),
+ grow_shrink_2(N-1, Orig, T).
+
+grow_shrink_3(0, T) ->
+ [] = ets:tab2list(T);
+grow_shrink_3(N, T) ->
+ true = ets:delete(T, N),
+ grow_shrink_3(N-1, T).
+
+grow_pseudo_deleted(doc) -> ["Grow a table that still contains pseudo-deleted objects"];
+grow_pseudo_deleted(suite) -> [];
+grow_pseudo_deleted(Config) when is_list(Config) ->
+ only_if_smp(fun() -> grow_pseudo_deleted_do() end).
+
+grow_pseudo_deleted_do() ->
+ lists:foreach(fun(Type) -> grow_pseudo_deleted_do(Type) end,
+ [set,bag,duplicate_bag]).
+
+grow_pseudo_deleted_do(Type) ->
+ process_flag(scheduler,1),
+ Self = self(),
+ ?line T = ets:new(kalle,[Type,public,{write_concurrency,true}]),
+ Mod = 7, Mult = 10000,
+ filltabint(T,Mod*Mult),
+ ?line true = ets:safe_fixtable(T,true),
+ ?line Mult = ets:select_delete(T,
+ [{{'$1', '_'},
+ [{'=:=', {'rem', '$1', Mod}, 0}],
+ [true]}]),
+ Left = Mult*(Mod-1),
+ ?line Left = ets:info(T,size),
+ ?line Mult = ets:info(T,kept_objects),
+ filltabstr(T,Mult),
+ spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Self ! start,
+ io:format("Starting to filltabstr... ~p\n",[now()]),
+ filltabstr(T,Mult,Mult+10000),
+ io:format("Done with filltabstr. ~p\n",[now()]),
+ Self ! done
+ end, [link, {scheduler,2}]),
+ ?line start = receive_any(),
+ io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
+ ?line true = ets:safe_fixtable(T,false),
+ io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]),
+ ?line false = ets:info(T,fixed),
+ ?line 0 = ets:info(T,kept_objects),
+ ?line done = receive_any(),
+ %%verify_table_load(T), % may fail if concurrency is poor (genny)
+ ets:delete(T),
+ process_flag(scheduler,0).
+
+shrink_pseudo_deleted(doc) -> ["Shrink a table that still contains pseudo-deleted objects"];
+shrink_pseudo_deleted(suite) -> [];
+shrink_pseudo_deleted(Config) when is_list(Config) ->
+ only_if_smp(fun()->shrink_pseudo_deleted_do() end).
+
+shrink_pseudo_deleted_do() ->
+ lists:foreach(fun(Type) -> shrink_pseudo_deleted_do(Type) end,
+ [set,bag,duplicate_bag]).
+
+shrink_pseudo_deleted_do(Type) ->
+ process_flag(scheduler,1),
+ Self = self(),
+ ?line T = ets:new(kalle,[Type,public,{write_concurrency,true}]),
+ Half = 10000,
+ filltabint(T,Half*2),
+ ?line true = ets:safe_fixtable(T,true),
+ ?line Half = ets:select_delete(T,
+ [{{'$1', '_'},
+ [{'>', '$1', Half}],
+ [true]}]),
+ ?line Half = ets:info(T,size),
+ ?line Half = ets:info(T,kept_objects),
+ spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Self ! start,
+ io:format("Starting to delete... ~p\n",[now()]),
+ del_one_by_one_set(T,1,Half+1),
+ io:format("Done with delete. ~p\n",[now()]),
+ Self ! done
+ end, [link, {scheduler,2}]),
+ ?line start = receive_any(),
+ io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
+ ?line true = ets:safe_fixtable(T,false),
+ io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]),
+ ?line false = ets:info(T,fixed),
+ ?line 0 = ets:info(T,kept_objects),
+ ?line done = receive_any(),
+ %%verify_table_load(T), % may fail if concurrency is poor (genny)
+ ets:delete(T),
+ process_flag(scheduler,0).
+
+
+meta_smp(suite) ->
+ [meta_lookup_unnamed_read,
+ meta_lookup_unnamed_write,
+ meta_lookup_named_read,
+ meta_lookup_named_write,
+ meta_newdel_unnamed,
+ meta_newdel_named].
+
+meta_lookup_unnamed_read(suite) -> [];
+meta_lookup_unnamed_read(Config) when is_list(Config) ->
+ InitF = fun(_) -> Tab = ets:new(unnamed,[]),
+ true = ets:insert(Tab,{key,data}),
+ Tab
+ end,
+ ExecF = fun(Tab) -> [{key,data}] = ets:lookup(Tab,key),
+ Tab
+ end,
+ FiniF = fun(Tab) -> true = ets:delete(Tab)
+ end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+meta_lookup_unnamed_write(suite) -> [];
+meta_lookup_unnamed_write(Config) when is_list(Config) ->
+ InitF = fun(_) -> Tab = ets:new(unnamed,[]),
+ {Tab,0}
+ end,
+ ExecF = fun({Tab,N}) -> true = ets:insert(Tab,{key,N}),
+ {Tab,N+1}
+ end,
+ FiniF = fun({Tab,_}) -> true = ets:delete(Tab)
+ end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+meta_lookup_named_read(suite) -> [];
+meta_lookup_named_read(Config) when is_list(Config) ->
+ InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)),
+ Tab = ets:new(Name,[named_table]),
+ true = ets:insert(Tab,{key,data}),
+ Tab
+ end,
+ ExecF = fun(Tab) -> [{key,data}] = ets:lookup(Tab,key),
+ Tab
+ end,
+ FiniF = fun(Tab) -> true = ets:delete(Tab)
+ end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+meta_lookup_named_write(suite) -> [];
+meta_lookup_named_write(Config) when is_list(Config) ->
+ InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)),
+ Tab = ets:new(Name,[named_table]),
+ {Tab,0}
+ end,
+ ExecF = fun({Tab,N}) -> true = ets:insert(Tab,{key,N}),
+ {Tab,N+1}
+ end,
+ FiniF = fun({Tab,_}) -> true = ets:delete(Tab)
+ end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+meta_newdel_unnamed(suite) -> [];
+meta_newdel_unnamed(Config) when is_list(Config) ->
+ InitF = fun(_) -> ok end,
+ ExecF = fun(_) -> Tab = ets:new(unnamed,[]),
+ true = ets:delete(Tab)
+ end,
+ FiniF = fun(_) -> ok end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+meta_newdel_named(suite) -> [];
+meta_newdel_named(Config) when is_list(Config) ->
+ InitF = fun([ProcN|_]) -> list_to_atom(integer_to_list(ProcN))
+ end,
+ ExecF = fun(Name) -> Name = ets:new(Name,[named_table]),
+ true = ets:delete(Name),
+ Name
+ end,
+ FiniF = fun(_) -> ok end,
+ run_workers(InitF,ExecF,FiniF,10000).
+
+smp_insert(doc) -> ["Concurrent insert's on same table"];
+smp_insert(suite) -> [];
+smp_insert(Config) when is_list(Config) ->
+ ets:new(smp_insert,[named_table,public,{write_concurrency,true}]),
+ InitF = fun(_) -> ok end,
+ ExecF = fun(_) -> true = ets:insert(smp_insert,{random:uniform(10000)})
+ end,
+ FiniF = fun(_) -> ok end,
+ run_workers(InitF,ExecF,FiniF,100000),
+ verify_table_load(smp_insert),
+ ets:delete(smp_insert).
+
+smp_fixed_delete(doc) -> ["Concurrent delete's on same fixated table"];
+smp_fixed_delete(suite) -> [];
+smp_fixed_delete(Config) when is_list(Config) ->
+ only_if_smp(fun()->smp_fixed_delete_do() end).
+
+smp_fixed_delete_do() ->
+ T = ets:new(foo,[public,{write_concurrency,true}]),
+ %%Mem = ets:info(T,memory),
+ NumOfObjs = 100000,
+ filltabint(T,NumOfObjs),
+ ets:safe_fixtable(T,true),
+ Buckets = num_of_buckets(T),
+ InitF = fun([ProcN,NumOfProcs|_]) -> {ProcN,NumOfProcs} end,
+ ExecF = fun({Key,_}) when Key > NumOfObjs ->
+ [end_of_work];
+ ({Key,Increment}) ->
+ true = ets:delete(T,Key),
+ {Key+Increment,Increment}
+ end,
+ FiniF = fun(_) -> ok end,
+ run_workers_do(InitF,ExecF,FiniF,NumOfObjs),
+ ?line 0 = ets:info(T,size),
+ ?line true = ets:info(T,fixed),
+ ?line Buckets = num_of_buckets(T),
+ ?line NumOfObjs = ets:info(T,kept_objects),
+ ets:safe_fixtable(T,false),
+ %% Will fail as unfix does not shrink the table:
+ %%?line Mem = ets:info(T,memory),
+ %%verify_table_load(T),
+ ets:delete(T).
+
+num_of_buckets(T) ->
+ ?line element(1,ets:info(T,stats)).
+
+smp_unfix_fix(doc) -> ["Fixate hash table while other process is busy doing unfix"];
+smp_unfix_fix(suite) -> [];
+smp_unfix_fix(Config) when is_list(Config) ->
+ only_if_smp(fun()-> smp_unfix_fix_do() end).
+
+smp_unfix_fix_do() ->
+ process_flag(scheduler,1),
+ Parent = self(),
+ T = ets:new(foo,[public,{write_concurrency,true}]),
+ %%Mem = ets:info(T,memory),
+ NumOfObjs = 100000,
+ Deleted = 50000,
+ filltabint(T,NumOfObjs),
+ ets:safe_fixtable(T,true),
+ Buckets = num_of_buckets(T),
+ ?line Deleted = ets:select_delete(T,[{{'$1', '_'},
+ [{'=<','$1', Deleted}],
+ [true]}]),
+ ?line Buckets = num_of_buckets(T),
+ Left = NumOfObjs - Deleted,
+ ?line Left = ets:info(T,size),
+ ?line true = ets:info(T,fixed),
+ ?line Deleted = ets:info(T,kept_objects),
+
+ {Child, Mref} =
+ spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Parent ! start,
+ io:format("Child waiting for table to be unfixed... now=~p mem=~p\n",
+ [now(),ets:info(T,memory)]),
+ repeat_while(fun()-> ets:info(T,fixed) end),
+ io:format("Table unfixed. Child Fixating! now=~p mem=~p\n",
+ [now(),ets:info(T,memory)]),
+ ?line true = ets:safe_fixtable(T,true),
+ repeat_while(fun(Key) when Key =< NumOfObjs ->
+ ets:delete(T,Key), {true,Key+1};
+ (Key) -> {false,Key}
+ end,
+ Deleted),
+ ?line 0 = ets:info(T,size),
+ ?line true = ets:info(T,kept_objects) >= Left,
+ ?line done = receive_any()
+ end,
+ [link, monitor, {scheduler,2}]),
+
+ ?line start = receive_any(),
+ ?line true = ets:info(T,fixed),
+ io:format("Parent starting to unfix... ~p\n",[now()]),
+ ets:safe_fixtable(T,false),
+ io:format("Parent done with unfix. ~p\n",[now()]),
+ Child ! done,
+ {'DOWN', Mref, process, Child, normal} = receive_any(),
+ ?line false = ets:info(T,fixed),
+ ?line 0 = ets:info(T,kept_objects),
+ %%verify_table_load(T),
+ ets:delete(T),
+ process_flag(scheduler,0).
+
+otp_8166(doc) -> ["Unsafe unfix was done by trapping select/match"];
+otp_8166(suite) -> [];
+otp_8166(Config) when is_list(Config) ->
+ only_if_smp(3, fun()-> otp_8166_do(false),
+ otp_8166_do(true)
+ end).
+
+otp_8166_do(WC) ->
+ %% Bug scenario: One process segv while reading the table because another
+ %% process is doing unfix without write-lock at the end of a trapping match_object.
+ process_flag(scheduler,1),
+ T = ets:new(foo,[public, {write_concurrency,WC}]),
+ NumOfObjs = 3000, %% Need more than 1000 live objects for match_object to trap one time
+ Deleted = NumOfObjs div 2,
+ filltabint(T,NumOfObjs),
+ {ReaderPid, ReaderMref} =
+ spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end,
+ [link, monitor, {scheduler,2}]),
+ {ZombieCrPid, ZombieCrMref} =
+ spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end,
+ [link, monitor, {scheduler,3}]),
+
+ repeat(fun() -> ZombieCrPid ! {loop, self()},
+ zombies_created = receive_any(),
+ otp_8166_trapper(T, 10, ZombieCrPid)
+ end,
+ 100),
+
+ ReaderPid ! quit,
+ {'DOWN', ReaderMref, process, ReaderPid, normal} = receive_any(),
+ ZombieCrPid ! quit,
+ {'DOWN', ZombieCrMref, process, ZombieCrPid, normal} = receive_any(),
+ ?line false = ets:info(T,fixed),
+ ?line 0 = ets:info(T,kept_objects),
+ %%verify_table_load(T),
+ ets:delete(T),
+ process_flag(scheduler,0).
+
+%% Keep reading the table
+otp_8166_reader(T, NumOfObjs) ->
+ repeat_while(fun(0) ->
+ receive quit -> {false,done}
+ after 0 -> {true,NumOfObjs}
+ end;
+ (Key) ->
+ ets:lookup(T,Key),
+ {true, Key-1}
+ end,
+ NumOfObjs).
+
+%% Do a match_object that will trap and thereby fixate and then unfixate the table
+otp_8166_trapper(T, Try, ZombieCrPid) ->
+ [] = ets:match_object(T,{'_',"Pink Unicorn"}),
+ case {ets:info(T,fixed),Try} of
+ {true,1} ->
+ io:format("failed to provoke unsafe unfix, give up...\n",[]),
+ ZombieCrPid ! unfix;
+ {true,_} ->
+ io:format("trapper too fast, trying again...\n",[]),
+ otp_8166_trapper(T, Try-1, ZombieCrPid);
+ {false,_} -> done
+ end.
+
+
+%% Fixate table and create some pseudo-deleted objects (zombies)
+%% Then wait for trapper to fixate before unfixing, as we want the trappers'
+%% unfix to be the one that purges the zombies.
+otp_8166_zombie_creator(T,Deleted) ->
+ case receive_any() of
+ quit -> done;
+
+ {loop,Pid} ->
+ filltabint(T,Deleted),
+ ets:safe_fixtable(T,true),
+ ?line Deleted = ets:select_delete(T,[{{'$1', '_'},
+ [{'=<','$1', Deleted}],
+ [true]}]),
+ Pid ! zombies_created,
+ repeat_while(fun() -> case ets:info(T,safe_fixed) of
+ {_,[_P1,_P2]} ->
+ false;
+ _ ->
+ receive unfix -> false
+ after 0 -> true
+ end
+ end
+ end),
+ ets:safe_fixtable(T,false),
+ otp_8166_zombie_creator(T,Deleted);
+
+ unfix ->
+ io:format("ignore unfix in outer loop?\n",[]),
+ otp_8166_zombie_creator(T,Deleted)
+ end.
+
+
+
+
+verify_table_load(T) ->
+ ?line Stats = ets:info(T,stats),
+ ?line {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen} = Stats,
+ ?line ok = if
+ AvgLen > 7 ->
+ io:format("Table overloaded: Stats=~p\n~p\n",
+ [Stats, ets:info(T)]),
+ false;
+
+ Buckets>256, AvgLen < 6 ->
+ io:format("Table underloaded: Stats=~p\n~p\n",
+ [Stats, ets:info(T)]),
+ false;
+
+ StdDev > ExpSD*2 ->
+ io:format("Too large standard deviation (poor hashing?),"
+ " stats=~p\n~p\n",[Stats, ets:info(T)]),
+ false;
+
+ true ->
+ io:format("Stats = ~p\n",[Stats]),
+ ok
+ end.
+
+
+
+
+
+smp_select_delete(suite) -> [];
+smp_select_delete(doc) ->
+ ["Run concurrent select_delete (and inserts) on same table."];
+smp_select_delete(Config) when is_list(Config) ->
+ T = ets:new(smp_select_delete,[named_table,public,{write_concurrency,true}]),
+ Mod = 17,
+ Zeros = erlang:make_tuple(Mod,0),
+ InitF = fun(_) -> Zeros end,
+ ExecF = fun(Diffs0) ->
+ case random:uniform(20) of
+ 1 ->
+ Mod = 17,
+ Eq = random:uniform(Mod) - 1,
+ Deleted = ets:select_delete(T,
+ [{{'_', '$1'},
+ [{'=:=', {'rem', '$1', Mod}, Eq}],
+ [true]}]),
+ Diffs1 = setelement(Eq+1, Diffs0,
+ element(Eq+1,Diffs0) - Deleted),
+ Diffs1;
+ _ ->
+ Key = random:uniform(10000),
+ Eq = Key rem Mod,
+ ?line case ets:insert_new(T,{Key,Key}) of
+ true ->
+ Diffs1 = setelement(Eq+1, Diffs0,
+ element(Eq+1,Diffs0)+1),
+ Diffs1;
+ false -> Diffs0
+ end
+ end
+ end,
+ FiniF = fun(Result) -> Result end,
+ Results = run_workers_do(InitF,ExecF,FiniF,20000),
+ ?line TotCnts = lists:foldl(fun(Diffs, Sum) -> add_lists(Sum,tuple_to_list(Diffs)) end,
+ lists:duplicate(Mod, 0), Results),
+ io:format("TotCnts = ~p\n",[TotCnts]),
+ ?line LeftInTab = lists:foldl(fun(N,Sum) -> Sum+N end,
+ 0, TotCnts),
+ io:format("LeftInTab = ~p\n",[LeftInTab]),
+ ?line LeftInTab = ets:info(T,size),
+ lists:foldl(fun(Cnt,Eq) ->
+ WasCnt = ets:select_count(T,
+ [{{'_', '$1'},
+ [{'=:=', {'rem', '$1', Mod}, Eq}],
+ [true]}]),
+ io:format("~p: ~p =?= ~p\n",[Eq,Cnt,WasCnt]),
+ ?line Cnt = WasCnt,
+ Eq+1
+ end,
+ 0, TotCnts),
+ verify_table_load(T),
+ ?line LeftInTab = ets:select_delete(T, [{{'$1','$1'}, [], [true]}]),
+ ?line 0 = ets:info(T,size),
+ ?line false = ets:info(T,fixed),
+ ets:delete(T).
+
+add_lists(L1,L2) ->
+ add_lists(L1,L2,[]).
+add_lists([],[],Acc) ->
+ lists:reverse(Acc);
+add_lists([E1|T1], [E2|T2], Acc) ->
+ add_lists(T1, T2, [E1+E2 | Acc]).
+
+run_workers(InitF,ExecF,FiniF,Laps) ->
+ case erlang:system_info(smp_support) of
+ true ->
+ run_workers_do(InitF,ExecF,FiniF,Laps);
+ false ->
+ {skipped,"No smp support"}
+ end.
+
+run_workers_do(InitF,ExecF,FiniF,Laps) ->
+ NumOfProcs = erlang:system_info(schedulers),
+ io:format("smp starting ~p workers\n",[NumOfProcs]),
+ Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)],
+ Parent = self(),
+ Pids = [spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end)
+ || Seed <- Seeds],
+ wait_pids(Pids).
+
+worker({ProcN,Seed}, InitF, ExecF, FiniF, Laps, Parent, NumOfProcs) ->
+ io:format("smp worker ~p, seed=~p~n",[self(),Seed]),
+ random:seed(Seed,Seed,Seed),
+ State1 = InitF([ProcN, NumOfProcs]),
+ State2 = worker_loop(Laps, ExecF, State1),
+ Result = FiniF(State2),
+ io:format("worker ~p done\n",[self()]),
+ Parent ! {self(), Result}.
+
+worker_loop(0, _, State) ->
+ State;
+worker_loop(_, _, [end_of_work|State]) ->
+ State;
+worker_loop(N, ExecF, State) ->
+ worker_loop(N-1,ExecF,ExecF(State)).
+
+wait_pids(Pids) ->
+ wait_pids(Pids,[]).
+wait_pids([],Acc) ->
+ Acc;
+wait_pids(Pids, Acc) ->
+ receive
+ {Pid,Result} ->
+ ?line true = lists:member(Pid,Pids),
+ Others = lists:delete(Pid,Pids),
+ io:format("wait_pid got ~p from ~p, still waiting for ~p\n",[Result,Pid,Others]),
+ wait_pids(Others,[Result | Acc])
+ end.
+
+
+
+
+my_tab_to_list(Ts) ->
+ Key = ets:first(Ts),
+ my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)]).
+
+my_tab_to_list(_Ts,'$end_of_table', Acc) -> lists:reverse(Acc);
+my_tab_to_list(Ts,Key, Acc) ->
+ my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)| Acc]).
+
+etsmem() ->
+ {try erlang:memory(ets) catch error:notsup -> notsup end,
+ case erlang:system_info({allocator,ets_alloc}) of
+ false -> undefined;
+ MemInfo ->
+ MSBCS = lists:foldl(
+ fun ({instance, _, L}, Acc) ->
+ {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
+ {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
+ [MBCS,SBCS | Acc]
+ end,
+ [],
+ MemInfo),
+ lists:foldl(
+ fun(L, {Bl0,BlSz0}) ->
+ {value,{_,Bl,_,_}} = lists:keysearch(blocks, 1, L),
+ {value,{_,BlSz,_,_}} = lists:keysearch(blocks_size, 1, L),
+ {Bl0+Bl,BlSz0+BlSz}
+ end, {0,0}, MSBCS)
+ end}.
+
+verify_etsmem(MemInfo) ->
+ wait_for_test_procs(),
+ case etsmem() of
+ MemInfo ->
+ io:format("Ets mem info: ~p", [MemInfo]),
+ case MemInfo of
+ {ErlMem,EtsAlloc} when ErlMem == notsup; EtsAlloc == undefined ->
+ %% Use 'erl +Mea max' to do more complete memory leak testing.
+ {comment,"Incomplete or no mem leak testing"};
+ _ ->
+ ok
+ end;
+ Other ->
+ io:format("Expected: ~p", [MemInfo]),
+ io:format("Actual: ~p", [Other]),
+ ?t:fail()
+ end.
+
+start_loopers(N, Prio, Fun, State) ->
+ lists:map(fun (_) ->
+ my_spawn_opt(fun () -> looper(Fun, State) end,
+ [{priority, Prio}, link])
+ end,
+ lists:seq(1, N)).
+
+stop_loopers(Loopers) ->
+ lists:foreach(fun (P) ->
+ unlink(P),
+ exit(P, bang)
+ end,
+ Loopers),
+ ok.
+
+looper(Fun, State) ->
+ looper(Fun, Fun(State)).
+
+spawn_logger(Procs) ->
+ receive
+ {new_test_proc, Proc} ->
+ spawn_logger([Proc|Procs]);
+ {sync_test_procs, Kill, From} ->
+ lists:foreach(fun (Proc) when From == Proc ->
+ ok;
+ (Proc) ->
+ Mon = erlang:monitor(process, Proc),
+ receive
+ {'DOWN', Mon, _, _, _} ->
+ ok
+ after 0 ->
+ case Kill of
+ true -> exit(Proc, kill);
+ _ -> ok
+ end,
+ receive
+ {'DOWN', Mon, _, _, _} ->
+ ok
+ end
+ end
+ end, Procs),
+ From ! test_procs_synced,
+ spawn_logger([From])
+ end.
+
+start_spawn_logger() ->
+ case whereis(ets_test_spawn_logger) of
+ Pid when is_pid(Pid) -> true;
+ _ -> register(ets_test_spawn_logger,
+ spawn_opt(fun () -> spawn_logger([]) end,
+ [{priority, max}]))
+ end.
+
+%% restart_spawn_logger() ->
+%% stop_spawn_logger(),
+%% start_spawn_logger().
+
+stop_spawn_logger() ->
+ Mon = erlang:monitor(process, ets_test_spawn_logger),
+ (catch exit(whereis(ets_test_spawn_logger), kill)),
+ receive {'DOWN', Mon, _, _, _} -> ok end,
+ ok.
+
+wait_for_test_procs() ->
+ wait_for_test_procs(false).
+
+wait_for_test_procs(Kill) ->
+ ets_test_spawn_logger ! {sync_test_procs, Kill, self()},
+ receive test_procs_synced -> ok end.
+
+log_test_proc(Proc) ->
+ ets_test_spawn_logger ! {new_test_proc, Proc},
+ Proc.
+
+my_spawn(Fun) -> log_test_proc(spawn(Fun)).
+%%my_spawn(M,F,A) -> log_test_proc(spawn(M,F,A)).
+%%my_spawn(N,M,F,A) -> log_test_proc(spawn(N,M,F,A)).
+
+my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)).
+my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)).
+%%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)).
+
+my_spawn_opt(Fun,Opts) -> log_test_proc(spawn_opt(Fun,Opts)).
+%%my_spawn_opt(M,F,A,Opts) -> log_test_proc(spawn_opt(M,F,A,Opts)).
+%%my_spawn_opt(N,M,F,A,Opts) -> log_test_proc(spawn_opt(N,M,F,A,Opts)).
+
+repeat(_Fun, 0) ->
+ ok;
+repeat(Fun, N) ->
+ Fun(),
+ repeat(Fun, N-1).
+
+repeat_while(Fun) ->
+ case Fun() of
+ true -> repeat_while(Fun);
+ false -> false
+ end.
+
+repeat_while(Fun, Arg0) ->
+ case Fun(Arg0) of
+ {true,Arg1} -> repeat_while(Fun,Arg1);
+ {false,Ret} -> Ret
+ end.
+
+receive_any() ->
+ receive M ->
+ io:format("Process ~p got msg ~p\n", [self(),M]),
+ M
+ end.
+
+receive_any_spinning() ->
+ receive_any_spinning(1000000).
+receive_any_spinning(Loops) ->
+ receive_any_spinning(Loops,Loops,1).
+receive_any_spinning(Loops,0,Tries) ->
+ receive M ->
+ io:format("Spinning process ~p got msg ~p after ~p tries\n", [self(),M,Tries]),
+ M
+ after 0 ->
+ receive_any_spinning(Loops, Loops, Tries+1)
+ end;
+receive_any_spinning(Loops, N, Tries) when N>0 ->
+ receive_any_spinning(Loops, N-1, Tries).
+
+
+
+spawn_monitor_with_pid(Pid, Fun) when is_pid(Pid) ->
+ spawn_monitor_with_pid(Pid, Fun, 1, 10).
+
+spawn_monitor_with_pid(Pid, Fun, N, M) when N > M*10 ->
+ spawn_monitor_with_pid(Pid, Fun, N, M*10);
+spawn_monitor_with_pid(Pid, Fun, N, M) ->
+ ?line false = is_process_alive(Pid),
+ case spawn(fun()-> case self() of
+ Pid -> Fun();
+ _ -> die
+ end
+ end) of
+ Pid ->
+ {Pid, erlang:monitor(process, Pid)};
+ Other ->
+ case N rem M of
+ 0 -> io:format("Failed ~p times to get pid ~p (current = ~p)\n",[N,Pid,Other]);
+ _ -> ok
+ end,
+ spawn_monitor_with_pid(Pid,Fun,N+1,M)
+ end.
+
+
+only_if_smp(Func) ->
+ only_if_smp(2, Func).
+only_if_smp(Schedulers, Func) ->
+ case {erlang:system_info(smp_support),
+ erlang:system_info(schedulers_online)} of
+ {false,_} -> {skip,"No smp support"};
+ {true,N} when N < Schedulers -> {skip,"Too few schedulers online"};
+ {true,_} -> Func()
+ end.
+
+
+%% Repeat test function with different combination of table options
+%%
+repeat_for_opts(F) ->
+ repeat_for_opts(F, [write_concurrency]).
+
+repeat_for_opts(F, OptGenList) when is_atom(F) ->
+ repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts) end, OptGenList);
+repeat_for_opts(F, OptGenList) ->
+ repeat_for_opts(F, OptGenList, []).
+
+repeat_for_opts(F, [], Acc) ->
+ lists:map(fun(Opts) ->
+ io:format("Calling with options ~p\n",[Opts]),
+ F(Opts)
+ end, Acc);
+repeat_for_opts(F, [OptList | Tail], []) when is_list(OptList) ->
+ repeat_for_opts(F, Tail, [[Opt] || Opt <- OptList]);
+repeat_for_opts(F, [OptList | Tail], AccList) when is_list(OptList) ->
+ repeat_for_opts(F, Tail, [[Opt|Acc] || Opt <- OptList, Acc <- AccList]);
+repeat_for_opts(F, [Atom | Tail], AccList) when is_atom(Atom) ->
+ repeat_for_opts(F, [repeat_for_opts_atom2list(Atom) | Tail ], AccList).
+
+repeat_for_opts_atom2list(all_types) -> [set,ordered_set,bag,duplicate_bag];
+repeat_for_opts_atom2list(write_concurrency) -> [{write_concurrency,false},{write_concurrency,true}].
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-18 13:13:31 +0000