diff options
Diffstat (limited to 'erts/emulator/test/code_SUITE.erl')
| -rw-r--r-- | erts/emulator/test/code_SUITE.erl | 1138 |
1 files changed, 786 insertions, 352 deletions
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 9f318a38be..1065b56e19 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,29 +19,28 @@ %% -module(code_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - versions/1,new_binary_types/1, - t_check_process_code/1,t_check_old_code/1, - t_check_process_code_ets/1, - external_fun/1,get_chunk/1,module_md5/1,make_stub/1, - make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, - false_dependency/1,coverage/1,fun_confusion/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + versions/1,new_binary_types/1, call_purged_fun_code_gone/1, + call_purged_fun_code_reload/1, call_purged_fun_code_there/1, + t_check_process_code/1,t_check_old_code/1, + t_check_process_code_ets/1, + external_fun/1,get_chunk/1,module_md5/1,make_stub/1, + make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, + false_dependency/1,coverage/1,fun_confusion/1, + t_copy_literals/1, t_copy_literals_frags/1]). -define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [versions, new_binary_types, t_check_process_code, + [versions, new_binary_types, call_purged_fun_code_gone, + call_purged_fun_code_reload, call_purged_fun_code_there, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion]. - -groups() -> - []. + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -51,12 +50,6 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false), ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% Make sure that only two versions of a module can be loaded. versions(Config) when is_list(Config) -> V1 = compile_version(1, Config), @@ -73,14 +66,14 @@ versions(Config) when is_list(Config) -> 2 = versions:version(), %% Kill processes, unload code. - P1 ! P2 ! done, _ = monitor(process, P1), _ = monitor(process, P2), + P1 ! P2 ! done, receive - {'DOWN',_,process,P1,normal} -> ok + {'DOWN',_,process,P1,normal} -> ok end, receive - {'DOWN',_,process,P2,normal} -> ok + {'DOWN',_,process,P2,normal} -> ok end, true = erlang:purge_module(versions), true = erlang:delete_module(versions), @@ -88,84 +81,241 @@ versions(Config) when is_list(Config) -> ok. compile_version(Version, Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "versions"), {ok,versions,Bin} = compile:file(File, [{d,'VERSION',Version}, - binary,report]), + binary,report]), Bin. load_version(Code, Ver) -> case erlang:load_module(versions, Code) of - {module,versions} -> - Pid = spawn_link(versions, loop, []), - Ver = versions:version(), - Ver = check_version(Pid), - {ok,Pid,Ver}; - Error -> - Error + {module,versions} -> + Pid = spawn_link(versions, loop, []), + Ver = versions:version(), + Ver = check_version(Pid), + {ok,Pid,Ver}; + Error -> + Error end. check_version(Pid) -> Pid ! {self(),version}, receive - {Pid,version,Version} -> - Version + {Pid,version,Version} -> + Version end. new_binary_types(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Bin} = compile:file(File, [binary]), - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Bin} = compile:file(File, [binary]), + {module,my_code_test} = erlang:load_module(my_code_test, + make_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), + + {module,my_code_test} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), %% Try heap binaries and bad binaries. - ?line {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_sub_binary(<<1,2>>)), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(<<1,2>>)), - ?line {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, - bit_sized_binary(Bin))), + {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), + {error,badfile} = erlang:load_module(my_code_test, + make_sub_binary(<<1,2>>)), + {error,badfile} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(<<1,2>>)), + {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, + bit_sized_binary(Bin))), + ok. + +call_purged_fun_code_gone(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + call_purged_fun_test(Priv, Data, code_gone), + ok. + +call_purged_fun_code_reload(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + Path = code:get_path(), + true = code:add_path(Priv), + try + call_purged_fun_test(Priv, Data, code_reload) + after + code:set_path(Path) + end, + ok. + +call_purged_fun_code_there(Config) when is_list(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + call_purged_fun_test(Priv, Data, code_there), + ok. + +call_purged_fun_test(Priv, Data, Type) -> + File = filename:join(Data, "my_code_test2"), + Code = filename:join(Priv, "my_code_test2"), + + catch erlang:purge_module(my_code_test2), + catch erlang:delete_module(my_code_test2), + catch erlang:purge_module(my_code_test2), + + {ok,my_code_test2} = c:c(File, [{outdir,Priv}]), + + T = ets:new(my_code_test2_fun_table, []), + ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}), + ets:insert(T, {my_fun2,my_code_test2:make_fun2()}), + + spawn(fun () -> + [{my_fun2,F2}] = ets:lookup(T, my_fun2), + F2(fun () -> + receive after infinity -> ok end + end, + fun () -> ok end), + exit(completed) + end), + + PurgeType = case Type of + code_gone -> + ok = file:delete(Code++".beam"), + true; + code_reload -> + true; + code_there -> + false + end, + + true = erlang:delete_module(my_code_test2), + + Purge = start_purge(my_code_test2, PurgeType), + + {P0, M0} = spawn_monitor(fun () -> + [{my_fun,F}] = ets:lookup(T, my_fun), + 4712 = F(1), + exit(completed) + end), + + wait_until(fun () -> + {status, suspended} + == process_info(P0, status) + end), + + ok = continue_purge(Purge), + + {P1, M1} = spawn_monitor(fun () -> + [{my_fun,F}] = ets:lookup(T, my_fun), + 4713 = F(2), + exit(completed) + end), + {P2, M2} = spawn_monitor(fun () -> + [{my_fun,F}] = ets:lookup(T, my_fun), + 4714 = F(3), + exit(completed) + end), + + wait_until(fun () -> + {status, suspended} + == process_info(P1, status) + end), + wait_until(fun () -> + {status, suspended} + == process_info(P2, status) + end), + + {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P0, current_function), + {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P1, current_function), + {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P2, current_function), + + case Type of + code_there -> + false = complete_purge(Purge); + _ -> + {true, true} = complete_purge(Purge) + end, + + case Type of + code_gone -> + receive + {'DOWN', M0, process, P0, Reason0} -> + {undef, _} = Reason0 + end, + receive + {'DOWN', M1, process, P1, Reason1} -> + {undef, _} = Reason1 + end, + receive + {'DOWN', M2, process, P2, Reason2} -> + {undef, _} = Reason2 + end; + _ -> + receive + {'DOWN', M0, process, P0, Reason0} -> + completed = Reason0 + end, + receive + {'DOWN', M1, process, P1, Reason1} -> + completed = Reason1 + end, + receive + {'DOWN', M2, process, P2, Reason2} -> + completed = Reason2 + end, + catch erlang:purge_module(my_code_test2), + catch erlang:delete_module(my_code_test2), + catch erlang:purge_module(my_code_test2) + end, ok. t_check_process_code(Config) when is_list(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line Code = filename:join(Priv, "my_code_test"), + case check_process_code_handle(indirect_references) of + false -> {skipped, "check_process_code() ignores funs"}; + true -> t_check_process_code_test(Config) + end. - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), +t_check_process_code_test(Config) -> + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + Code = filename:join(Priv, "my_code_test"), - ?line MyFun = fun(X, Y) -> X + Y end, %Confuse things. - ?line F = my_code_test:make_fun(42), - ?line 2 = fun_refc(F), - ?line MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. - ?line 44 = F(2), + catch erlang:purge_module(my_code_test), + catch erlang:delete_module(my_code_test), + catch erlang:purge_module(my_code_test), + + {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + + MyFun = fun(X, Y) -> X + Y end, %Confuse things. + F = my_code_test:make_fun(42), + 2 = fun_refc(F), + MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. + 44 = F(2), %% Delete the module and call the fun again. - ?line true = erlang:delete_module(my_code_test), - ?line 2 = fun_refc(F), - ?line 45 = F(3), - ?line {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), + true = erlang:delete_module(my_code_test), + 2 = fun_refc(F), + 45 = F(3), + {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), %% The fun should still be there, preventing purge. - ?line true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(self(), my_code_test), gc(), gc(), %Place funs on the old heap. - ?line true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(self(), my_code_test), %% Using the funs here guarantees that they will not be prematurely garbed. - ?line 48 = F(6), - ?line 3 = MyFun(1, 2), - ?line 12 = MyFun2(3, 4), + 48 = F(6), + 3 = MyFun(1, 2), + 12 = MyFun2(3, 4), %% Kill all funs. t_check_process_code1(Code, []). @@ -173,64 +323,64 @@ t_check_process_code(Config) when is_list(Config) -> %% The real fun was killed, but we have some fakes which look similar. t_check_process_code1(Code, Fakes) -> - ?line MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. - ?line false = erlang:check_process_code(self(), my_code_test), - ?line 4 = MyFun(1, 2), + MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. + false = erlang:check_process_code(self(), my_code_test), + 4 = MyFun(1, 2), t_check_process_code2(Code, Fakes). t_check_process_code2(Code, _) -> - ?line false = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:purge_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), + true = erlang:purge_module(my_code_test), %% In the next test we will load the same module twice. - ?line {module,my_code_test} = code:load_abs(Code), - ?line F = my_code_test:make_fun(37), - ?line 2 = fun_refc(F), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line {module,my_code_test} = code:load_abs(Code), - ?line 2 = fun_refc(F), + {module,my_code_test} = code:load_abs(Code), + F = my_code_test:make_fun(37), + 2 = fun_refc(F), + false = erlang:check_process_code(self(), my_code_test), + {module,my_code_test} = code:load_abs(Code), + 2 = fun_refc(F), %% Still false because the fun with the same identify is found %% in the current code. - ?line false = erlang:check_process_code(self(), my_code_test), - + false = erlang:check_process_code(self(), my_code_test), + %% Some fake funs in the same module should not do any difference. - ?line false = erlang:check_process_code(self(), my_code_test), + false = erlang:check_process_code(self(), my_code_test), 38 = F(1), t_check_process_code3(Code, F, []). t_check_process_code3(Code, F, Fakes) -> Pid = spawn_link(fun() -> body(F, Fakes) end), - ?line true = erlang:purge_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line false = erlang:check_process_code(Pid, my_code_test), + true = erlang:purge_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), + false = erlang:check_process_code(Pid, my_code_test), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:check_process_code(Pid, my_code_test), + true = erlang:delete_module(my_code_test), + true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(Pid, my_code_test), 39 = F(2), t_check_process_code4(Code, Pid). t_check_process_code4(_Code, Pid) -> Pid ! drop_funs, receive after 1 -> ok end, - ?line false = erlang:check_process_code(Pid, my_code_test), + false = erlang:check_process_code(Pid, my_code_test), ok. body(F, Fakes) -> receive - jog -> - 40 = F(3), - erlang:garbage_collect(), - body(F, Fakes); - drop_funs -> - dropped_body() + jog -> + 40 = F(3), + erlang:garbage_collect(), + body(F, Fakes); + drop_funs -> + dropped_body() end. dropped_body() -> receive - X -> exit(X) + X -> exit(X) end. gc() -> @@ -238,61 +388,66 @@ gc() -> gc1(). gc1() -> ok. -t_check_process_code_ets(doc) -> - "Test check_process_code/2 in combination with a fun obtained from an ets table."; +%% Test check_process_code/2 in combination with a fun obtained from an ets table. t_check_process_code_ets(Config) when is_list(Config) -> - case test_server:is_native(?MODULE) of - true -> - {skip,"Native code"}; + case check_process_code_handle(indirect_references) of false -> - do_check_process_code_ets(Config) + {skipped, "check_process_code() ignores funs"}; + true -> + case test_server:is_native(?MODULE) of + true -> + {skip,"Native code"}; + false -> + do_check_process_code_ets(Config) + end end. do_check_process_code_ets(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - ?line T = ets:new(my_code_test, []), - ?line ets:insert(T, {7,my_code_test:make_fun(107)}), - ?line ets:insert(T, {8,my_code_test:make_fun(108)}), - ?line erlang:delete_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + + catch erlang:purge_module(my_code_test), + catch erlang:delete_module(my_code_test), + catch erlang:purge_module(my_code_test), + {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + + T = ets:new(my_code_test, []), + ets:insert(T, {7,my_code_test:make_fun(107)}), + ets:insert(T, {8,my_code_test:make_fun(108)}), + erlang:delete_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), Body = fun() -> - [{7,F1}] = ets:lookup(T, 7), - [{8,F2}] = ets:lookup(T, 8), - IdleLoop = fun() -> receive _X -> ok end end, - RecLoop = fun(Again) -> - receive - call -> 110 = F1(3), - 100 = F2(-8), - Again(Again); - {drop_funs,To} -> - To ! funs_dropped, - IdleLoop() - end - end, - true = erlang:check_process_code(self(), my_code_test), - RecLoop(RecLoop) - end, - ?line Pid = spawn_link(Body), + [{7,F1}] = ets:lookup(T, 7), + [{8,F2}] = ets:lookup(T, 8), + IdleLoop = fun() -> receive _X -> ok end end, + RecLoop = fun(Again) -> + receive + call -> 110 = F1(3), + 100 = F2(-8), + Again(Again); + {drop_funs,To} -> + To ! funs_dropped, + IdleLoop() + end + end, + true = erlang:check_process_code(self(), my_code_test), + RecLoop(RecLoop) + end, + Pid = spawn_link(Body), receive after 1 -> ok end, - ?line true = erlang:check_process_code(Pid, my_code_test), + true = erlang:check_process_code(Pid, my_code_test), Pid ! call, Pid ! {drop_funs,self()}, receive - funs_dropped -> ok; - Other -> ?t:fail({unexpected,Other}) + funs_dropped -> ok; + Other -> ct:fail({unexpected,Other}) after 10000 -> - ?line ?t:fail(no_funs_dropped_answer) + ct:fail(no_funs_dropped_answer) end, - ?line false = erlang:check_process_code(Pid, my_code_test), + false = erlang:check_process_code(Pid, my_code_test), ok. fun_refc(F) -> @@ -302,89 +457,89 @@ fun_refc(F) -> %% Test the erlang:check_old_code/1 BIF. t_check_old_code(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + + catch erlang:purge_module(my_code_test), + catch erlang:delete_module(my_code_test), + catch erlang:purge_module(my_code_test), - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line catch erlang:purge_module(my_code_test), + false = erlang:check_old_code(my_code_test), - ?line false = erlang:check_old_code(my_code_test), + {ok,my_code_test,Code} = compile:file(File, [binary]), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - - ?line false = erlang:check_old_code(my_code_test), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line true = erlang:check_old_code(my_code_test), + false = erlang:check_old_code(my_code_test), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), + true = erlang:check_old_code(my_code_test), - ?line true = erlang:purge_module(my_code_test), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + true = erlang:purge_module(my_code_test), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), + + {'EXIT',_} = (catch erlang:check_old_code([])), - ?line {'EXIT',_} = (catch erlang:check_old_code([])), - ok. external_fun(Config) when is_list(Config) -> - ?line false = erlang:function_exported(another_code_test, x, 1), + false = erlang:function_exported(another_code_test, x, 1), AnotherCodeTest = id(another_code_test), ExtFun = fun AnotherCodeTest:x/1, - ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), - ?line false = erlang:function_exported(another_code_test, x, 1), - ?line false = lists:member(another_code_test, erlang:loaded()), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "another_code_test"), - ?line {ok,another_code_test,Code} = compile:file(File, [binary,report]), - ?line {module,another_code_test} = erlang:load_module(another_code_test, Code), - ?line 42 = ExtFun(answer), + {'EXIT',{undef,_}} = (catch ExtFun(answer)), + false = erlang:function_exported(another_code_test, x, 1), + false = lists:member(another_code_test, erlang:loaded()), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "another_code_test"), + {ok,another_code_test,Code} = compile:file(File, [binary,report]), + {module,another_code_test} = erlang:load_module(another_code_test, Code), + 42 = ExtFun(answer), ok. get_chunk(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = get_chunk_ok("Atom", Code), - ?line Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), - ?line Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), + Chunk = get_chunk_ok("Atom", Code), + Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), + Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), %% Invalid beam code or missing chunk should return 'undefined'. - ?line undefined = code:get_chunk(<<"not a beam module">>, "Atom"), - ?line undefined = code:get_chunk(Code, "XXXX"), + undefined = code:get_chunk(<<"not a beam module">>, "Atom"), + undefined = code:get_chunk(Code, "XXXX"), ok. get_chunk_ok(Chunk, Code) -> case code:get_chunk(Code, Chunk) of - Bin when is_binary(Bin) -> Bin + Bin when is_binary(Bin) -> Bin end. module_md5(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = module_md5_ok(Code), - ?line Chunk = module_md5_ok(make_sub_binary(Code)), - ?line Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), + Chunk = module_md5_ok(Code), + Chunk = module_md5_ok(make_sub_binary(Code)), + Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), + {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), %% Invalid beam code should return 'undefined'. - ?line undefined = code:module_md5(<<"not a beam module">>), + undefined = code:module_md5(<<"not a beam module">>), ok. - + module_md5_ok(Code) -> case code:module_md5(Code) of - Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin + Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin end. @@ -392,107 +547,138 @@ make_stub(Config) when is_list(Config) -> catch erlang:purge_module(my_code_test), MD5 = erlang:md5(<<>>), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), - ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), - ?line my_code_test = code:make_stub_module(my_code_test, - make_unaligned_sub_binary(Code), - {[],[],MD5}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + my_code_test = code:make_stub_module(my_code_test, + make_unaligned_sub_binary(Code), + {[],[],MD5}), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), - ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), - {[],[],MD5}), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), + {[],[],MD5}), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), %% Should fail. - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test, - bit_sized_binary(Code), - {[],[],MD5})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(my_code_test_with_wrong_name, - Code, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, + bit_sized_binary(Code), + {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test_with_wrong_name, + Code, {[],[],MD5})), ok. make_stub_many_funs(Config) when is_list(Config) -> catch erlang:purge_module(many_funs), MD5 = erlang:md5(<<>>), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "many_funs"), - ?line {ok,many_funs,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "many_funs"), + {ok,many_funs,Code} = compile:file(File, [binary]), - ?line many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}), - ?line true = erlang:delete_module(many_funs), - ?line true = erlang:purge_module(many_funs), - ?line many_funs = code:make_stub_module(many_funs, - make_unaligned_sub_binary(Code), - {[],[],MD5}), - ?line true = erlang:delete_module(many_funs), - ?line true = erlang:purge_module(many_funs), + many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}), + true = erlang:delete_module(many_funs), + true = erlang:purge_module(many_funs), + many_funs = code:make_stub_module(many_funs, + make_unaligned_sub_binary(Code), + {[],[],MD5}), + true = erlang:delete_module(many_funs), + true = erlang:purge_module(many_funs), %% Should fail. - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, - bit_sized_binary(Code), - {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, + bit_sized_binary(Code), + {[],[],MD5})), ok. constant_pools(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "literals"), - ?line {ok,literals,Code} = compile:file(File, [report,binary]), - ?line {module,literals} = erlang:load_module(literals, - make_sub_binary(Code)), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, + make_sub_binary(Code)), %% Initialize. - ?line A = literals:a(), - ?line B = literals:b(), - ?line C = literals:huge_bignum(), - ?line process_flag(trap_exit, true), + A = literals:a(), + B = literals:b(), + C = literals:huge_bignum(), + process_flag(trap_exit, true), Self = self(), %% Have a process WITHOUT old heap that references the literals %% in the 'literals' module. - ?line NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), + NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(NoOldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line true = erlang:purge_module(literals), - ?line NoOldHeap ! done, - ?line receive - {'EXIT',NoOldHeap,{A,B,C}} -> - ok; - Other -> - ?line ?t:fail({unexpected,Other}) - end, - ?line {module,literals} = erlang:load_module(literals, Code), + true = erlang:delete_module(literals), + false = erlang:check_process_code(NoOldHeap, literals), + erlang:check_process_code(self(), literals), + true = erlang:purge_module(literals), + NoOldHeap ! done, + receive + {'EXIT',NoOldHeap,{A,B,C}} -> + ok; + Other -> + ct:fail({unexpected,Other}) + end, + {module,literals} = erlang:load_module(literals, Code), %% Have a process WITH an old heap that references the literals %% in the 'literals' module. - ?line OldHeap = spawn_link(fun() -> old_heap(Self) end), + OldHeap = spawn_link(fun() -> old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(OldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line erlang:purge_module(literals), - ?line OldHeap ! done, + true = erlang:delete_module(literals), + false = erlang:check_process_code(OldHeap, literals), + erlang:check_process_code(self(), literals), + erlang:purge_module(literals), + OldHeap ! done, receive {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> ok - end. + end, + + {module,literals} = erlang:load_module(literals, Code), + %% Have a hibernated process that references the literals + %% in the 'literals' module. + {Hib, Mon} = spawn_monitor(fun() -> hibernated(Self) end), + receive go -> ok end, + [{heap_size,OldHeapSz}, + {total_heap_size,OldTotHeapSz}] = process_info(Hib, [heap_size, + total_heap_size]), + OldHeapSz = OldTotHeapSz, + io:format("OldHeapSz=~p OldTotHeapSz=~p~n", [OldHeapSz, OldTotHeapSz]), + true = erlang:delete_module(literals), + false = erlang:check_process_code(Hib, literals), + erlang:check_process_code(self(), literals), + erlang:purge_module(literals), + receive after 1000 -> ok end, + [{heap_size,HeapSz}, + {total_heap_size,TotHeapSz}] = process_info(Hib, [heap_size, + total_heap_size]), + io:format("HeapSz=~p TotHeapSz=~p~n", [HeapSz, TotHeapSz]), + Hib ! hej, + receive + {'DOWN', Mon, process, Hib, Reason} -> + {undef, [{no_module, + no_function, + [{A,B,C,[1,2,3|_]=Seq}], _}]} = Reason, + 16 = length(Seq) + end, + HeapSz = TotHeapSz, %% Ensure restored to hibernated state... + true = HeapSz > OldHeapSz, + ok. no_old_heap(Parent) -> A = literals:a(), @@ -500,8 +686,8 @@ no_old_heap(Parent) -> Res = {A,B,literals:huge_bignum()}, Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. old_heap(Parent) -> @@ -511,16 +697,23 @@ old_heap(Parent) -> create_old_heap(), Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. +hibernated(Parent) -> + A = literals:a(), + B = literals:b(), + Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)}, + Parent ! go, + erlang:hibernate(no_module, no_function, [Res]). + create_old_heap() -> case process_info(self(), [heap_size,total_heap_size]) of - [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> - ok; - _ -> - create_old_heap() + [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> + ok; + _ -> + create_old_heap() end. constant_refc_binaries(Config) when is_list(Config) -> @@ -529,7 +722,7 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) before test: ~p\n", [Bef]), %% Compile the the literals module. - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "literals"), {ok,literals,Code} = compile:file(File, [report,binary]), @@ -554,29 +747,29 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) after test: ~p", [Aft]), Diff = Aft - Bef, if - Diff < 0 -> - io:format("~p less bytes", [abs(Diff)]); - Diff > 0 -> - io:format("~p more bytes", [Diff]); - true -> - ok + Diff < 0 -> + io:format("~p less bytes", [abs(Diff)]); + Diff > 0 -> + io:format("~p more bytes", [Diff]); + true -> + ok end, %% Test for leaks. We must accept some natural variations in %% the size of allocated binaries. if - Diff > 64*1024 -> - ?t:fail(binary_leak); - true -> - ok + Diff > 64*1024 -> + ct:fail(binary_leak); + true -> + ok end. memory_binary() -> try - erlang:memory(binary) + erlang:memory(binary) catch - error:notsup -> - 0 + error:notsup -> + 0 end. provoke_mem_leak(0, _, _) -> ok; @@ -586,19 +779,19 @@ provoke_mem_leak(N, Code, Check) -> %% Create several processes with references to the literal binary. Self = self(), Pids = [spawn_link(fun() -> - create_binaries(Self, NumRefs, Check) - end) || NumRefs <- lists:seq(1, 10)], + create_binaries(Self, NumRefs, Check) + end) || NumRefs <- lists:seq(1, 10)], [receive {started,Pid} -> ok end || Pid <- Pids], %% Make the code old and remove references to the constant pool %% in all processes. true = erlang:delete_module(literals), Ms = [spawn_monitor(fun() -> - false = erlang:check_process_code(Pid, literals) - end) || Pid <- Pids], + false = erlang:check_process_code(Pid, literals) + end) || Pid <- Pids], [receive - {'DOWN',R,process,P,normal} -> - ok + {'DOWN',R,process,P,normal} -> + ok end || {P,R} <- Ms], %% Purge the code. @@ -606,14 +799,14 @@ provoke_mem_leak(N, Code, Check) -> %% Tell the processes that the code has been purged. [begin - monitor(process, Pid), - Pid ! purged + monitor(process, Pid), + Pid ! purged end || Pid <- Pids], %% Wait for all processes to terminate. [receive - {'DOWN',_,process,Pid,normal} -> - ok + {'DOWN',_,process,Pid,normal} -> + ok end || Pid <- Pids], %% We now expect that the binary has been deallocated. @@ -625,112 +818,112 @@ create_binaries(Parent, NumRefs, Check) -> {bits,Bits} = literals:bits(), Parent ! {started,self()}, receive - purged -> - %% The code has been purged. Now make sure that - %% the binaries haven't been corrupted. - Check = erlang:md5(Bin), - [Bin = B || B <- Bins], - <<42:13,Bin/binary>> = Bits, - - %% Remove all references to the binaries - %% Doing it explicitly like this ensures that - %% the binaries are gone when the parent process - %% receives the 'DOWN' message. - erlang:garbage_collect() + purged -> + %% The code has been purged. Now make sure that + %% the binaries haven't been corrupted. + Check = erlang:md5(Bin), + [Bin = B || B <- Bins], + <<42:13,Bin/binary>> = Bits, + + %% Remove all references to the binaries + %% Doing it explicitly like this ensures that + %% the binaries are gone when the parent process + %% receives the 'DOWN' message. + erlang:garbage_collect() end. wait_for_memory_deallocations() -> try - erts_debug:set_internal_state(wait, deallocations) + erts_debug:set_internal_state(wait, deallocations) catch - error:undef -> - erts_debug:set_internal_state(available_internal_state, true), - wait_for_memory_deallocations() + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() end. %% OTP-7559: c_p->cp could contain garbage and create a false dependency %% to a module in a process. (Thanks to Richard Carlsson.) false_dependency(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "cpbugx"), - ?line {ok,cpbugx,Code} = compile:file(File, [binary,report]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "cpbugx"), + {ok,cpbugx,Code} = compile:file(File, [binary,report]), do_false_dependency(fun cpbugx:before/0, Code), do_false_dependency(fun cpbugx:before2/0, Code), do_false_dependency(fun cpbugx:before3/0, Code), -%% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. -%% Parent = self(), -%% ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), -%% ?line receive initialized -> ok end, + %% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. + %% Parent = self(), + %% Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), + %% receive initialized -> ok end, -%% %% Reload the module. Make sure the process is still alive. -%% ?line {module,cpbugx} = erlang:load_module(cpbugx, Bin), -%% ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), -%% ?line true = is_process_alive(Pid), + %% %% Reload the module. Make sure the process is still alive. + %% {module,cpbugx} = erlang:load_module(cpbugx, Bin), + %% io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + %% true = is_process_alive(Pid), -%% %% There should not be any dependency to cpbugx. -%% ?line false = erlang:check_process_code(Pid, cpbugx), - + %% %% There should not be any dependency to cpbugx. + %% false = erlang:check_process_code(Pid, cpbugx), -%% %% Kill the process. -%% ?line unlink(Pid), exit(Pid, kill), + + %% %% Kill the process. + %% unlink(Pid), exit(Pid, kill), ok. do_false_dependency(Init, Code) -> - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), + {module,cpbugx} = erlang:load_module(cpbugx, Code), %% Spawn process. Make sure it has the appropriate init function %% and returned. CP should not contain garbage after the return. Parent = self(), - ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), - ?line receive initialized -> ok end, + Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), + receive initialized -> ok end, %% Reload the module. Make sure the process is still alive. - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), - ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), - ?line true = is_process_alive(Pid), + {module,cpbugx} = erlang:load_module(cpbugx, Code), + io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + true = is_process_alive(Pid), %% There should not be any dependency to cpbugx. - ?line false = erlang:check_process_code(Pid, cpbugx), + false = erlang:check_process_code(Pid, cpbugx), %% Kill the process and completely unload the code. - ?line unlink(Pid), exit(Pid, kill), - ?line true = erlang:purge_module(cpbugx), - ?line true = erlang:delete_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on deleted code - ?line true = erlang:purge_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on purged code + unlink(Pid), exit(Pid, kill), + true = erlang:purge_module(cpbugx), + true = erlang:delete_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on deleted code + true = erlang:purge_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on purged code ok. - + false_dependency_loop(Parent, Init, SendInitAck) -> Init(), case SendInitAck of - true -> Parent ! initialized; - false -> void - %% Just send one init-ack. I guess the point of this test - %% wasn't to fill parents msg-queue (?). Seen to cause - %% out-of-mem (on halfword-vm for some reason) by - %% 91 million msg in queue. /sverker + true -> Parent ! initialized; + false -> void + %% Just send one init-ack. I guess the point of this test + %% wasn't to fill parents msg-queue (?). Seen to cause + %% out-of-mem (on halfword-vm for some reason) by + %% 91 million msg in queue. /sverker end, receive - _ -> false_dependency_loop(Parent, Init, false) + _ -> false_dependency_loop(Parent, Init, false) end. coverage(Config) when is_list(Config) -> - ?line code:is_module_native(?MODULE), - ?line {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), - ?line {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), - ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), + code:is_module_native(?MODULE), + {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), + {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), + {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), + {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. fun_confusion(Config) when is_list(Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), Src = filename:join(Data, "fun_confusion"), Mod = fun_confusion, @@ -753,6 +946,208 @@ compile_load(Mod, Src, Ver) -> {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), ok. + +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the literals module. + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, Code), + + N = 30, + Me = self(), + %% reload literals code every 567 ms + Rel = spawn_link(fun() -> reloader(literals,Code,567) end), + %% add new literal msgs to the loop every 789 ms + Sat = spawn_link(fun() -> saturate(Me,789) end), + %% run for 10s + _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end), + ok = chase_msg(N, Me), + %% cleanup + Rel ! done, + Sat ! done, + ok = flush(), + ok. + +-define(mod, t_copy_literals_frags). +t_copy_literals_frags(Config) when is_list(Config) -> + Bin = gen_lit(?mod,[{a,{1,2,3,4,5,6,7}}, + {b,"hello world"}, + {c, <<"hello world">>}, + {d, {"hello world", {1.0, 2.0, <<"some">>, "string"}}}, + {e, <<"off heap", 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9,10,11,12,13,14,15>>}]), + + {module, ?mod} = erlang:load_module(?mod, Bin), + N = 6000, + Recv = spawn_opt(fun() -> receive + read -> + io:format("reading"), + literal_receiver() + end + end, [link,{min_heap_size, 10000}]), + Switcher = spawn_link(fun() -> literal_switcher() end), + Pids = [spawn_opt(fun() -> receive + {Pid, go, Recv, N} -> + io:format("sender batch (~w) start ~w~n",[N,self()]), + literal_sender(N,Recv), + Pid ! {self(), ok} + end + end, [link,{min_heap_size,800}]) || _ <- lists:seq(1,100)], + _ = [Pid ! {self(), go, Recv, N} || Pid <- Pids], + %% don't read immediately + timer:sleep(5), + Recv ! read, + Switcher ! {switch,?mod,Bin,[Recv|Pids],200}, + _ = [receive {Pid, ok} -> ok end || Pid <- Pids], + Switcher ! {self(), done}, + receive {Switcher, ok} -> ok end, + Recv ! {self(), done}, + receive {Recv, ok} -> ok end, + ok. + +literal_receiver() -> + receive + {Pid, done} -> + io:format("reader_done~n"), + Pid ! {self(), ok}; + {_Pid, msg, [A,B,C,D,E]} -> + A = ?mod:a(), + B = ?mod:b(), + C = ?mod:c(), + D = ?mod:d(), + E = ?mod:e(), + literal_receiver(); + {Pid, sender_confirm} -> + io:format("sender confirm ~w~n", [Pid]), + Pid ! {self(), ok}, + literal_receiver() + end. + +literal_sender(0, Recv) -> + Recv ! {self(), sender_confirm}, + receive {Recv, ok} -> ok end; +literal_sender(N, Recv) -> + Recv ! {self(), msg, [?mod:a(), + ?mod:b(), + ?mod:c(), + ?mod:d(), + ?mod:e()]}, + literal_sender(N - 1, Recv). + +literal_switcher() -> + receive + {switch,Mod,Bin,Pids,Tmo} -> + literal_switcher(Mod,Bin,Pids,Tmo) + end. +literal_switcher(Mod,Bin,Pids,Tmo) -> + receive + {Pid,done} -> + Pid ! {self(),ok} + after Tmo -> + io:format("load module ~w~n", [Mod]), + {module, Mod} = erlang:load_module(Mod,Bin), + ok = check_and_purge(Pids,Mod), + io:format("purge complete ~w~n", [Mod]), + literal_switcher(Mod,Bin,Pids,Tmo+Tmo) + end. + +check_and_purge([],Mod) -> + erlang:purge_module(Mod), + ok; +check_and_purge(Pids,Mod) -> + io:format("purge ~w~n", [Mod]), + Tag = make_ref(), + _ = [begin + erlang:check_process_code(Pid,Mod,[{async,{Tag,Pid}}]) + end || Pid <- Pids], + Retry = check_and_purge_receive(Pids,Tag,[]), + check_and_purge(Retry,Mod). + +check_and_purge_receive([Pid|Pids],Tag,Retry) -> + receive + {check_process_code, {Tag, Pid}, false} -> + check_and_purge_receive(Pids,Tag,Retry); + {check_process_code, {Tag, Pid}, true} -> + check_and_purge_receive(Pids,Tag,[Pid|Retry]) + end; +check_and_purge_receive([],_,Retry) -> + Retry. + + +gen_lit(Module,Terms) -> + FunStrings = [lists:flatten(io_lib:format("~w() -> ~w.~n", [F,Term]))||{F,Term}<-Terms], + FunForms = function_forms(FunStrings), + Forms = [{attribute,erl_anno:new(1),module,Module}, + {attribute,erl_anno:new(2),export,[FA || {FA,_} <- FunForms]}] ++ + [Function || {_, Function} <- FunForms], + {ok, Module, Bin} = compile:forms(Forms), + Bin. + +function_forms([]) -> []; +function_forms([S|Ss]) -> + {ok, Ts,_} = erl_scan:string(S), + {ok, Form} = erl_parse:parse_form(Ts), + Fun = element(3, Form), + Arity = element(4, Form), + [{{Fun,Arity}, Form}|function_forms(Ss)]. + +chase_msg(0, Pid) -> + chase_loop(Pid); +chase_msg(N, Master) -> + Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end), + chase_loop(Pid). + +chase_loop(Pid) -> + receive + done -> + Pid ! done, + ok; + {_From,Msg} -> + Pid ! {self(), Msg}, + ok = traverse(Msg), + chase_loop(Pid) + end. + +saturate(Pid,Time) -> + Es = [msg1,msg2,msg3,msg4,msg5], + Msg = [literals:E()||E <- Es], + Pid ! {self(), Msg}, + receive + done -> ok + after Time -> + saturate(Pid,Time) + end. + +traverse([]) -> ok; +traverse([H|T]) -> + ok = traverse(H), + traverse(T); +traverse(T) when is_tuple(T) -> ok; +traverse(B) when is_binary(B) -> ok; +traverse(I) when is_integer(I) -> ok; +traverse(#{ 1 := V1, b := V2 }) -> + ok = traverse(V1), + ok = traverse(V2), + ok. + + +reloader(Mod,Code,Time) -> + receive + done -> ok + after Time -> + code:purge(Mod), + {module,Mod} = erlang:load_module(Mod, Code), + reloader(Mod,Code,Time) + end. + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> @@ -775,4 +1170,43 @@ bit_sized_binary(Bin0) -> BitSize = 8*size(Bin) + 1, Bin. +flush() -> + receive _ -> flush() after 0 -> ok end. + id(I) -> I. + +check_process_code_handle(What) -> + lists:member(What, erlang:system_info(check_process_code)). + +wait_until(Fun) -> + case Fun() of + true -> + ok; + false -> + receive after 100 -> ok end, + wait_until(Fun) + end. + +start_purge(Mod, Type) when is_atom(Mod) + andalso ((Type == true) + orelse (Type == false)) -> + Ref = make_ref(), + erts_code_purger ! {test_purge, Mod, self(), Type, Ref}, + receive + {started, Ref} -> + Ref + end. + +continue_purge(Ref) when is_reference(Ref) -> + erts_code_purger ! {continue, Ref}, + receive + {continued, Ref} -> + ok + end. + +complete_purge(Ref) when is_reference(Ref) -> + erts_code_purger ! {complete, Ref}, + receive + {test_purge, Res, Ref} -> + Res + end. |