%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-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. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% %CopyrightEnd% %% -module(code_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("syntax_tools/include/merl.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). -export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, replace_path/1, load_file/1, load_abs/1, ensure_loaded/1, delete/1, purge/1, purge_many_exits/1, soft_purge/1, is_loaded/1, all_loaded/1, load_binary/1, dir_req/1, object_code/1, set_path_file/1, upgrade/1, sticky_dir/1, pa_pz_option/1, add_del_path/1, dir_disappeared/1, ext_mod_dep/1, clash/1, where_is_file/1, purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, code_archive/1, code_archive2/1, on_load/1, on_load_binary/1, on_load_embedded/1, on_load_errors/1, on_load_update/1, on_load_purge/1, on_load_self_call/1, on_load_pending/1, on_load_deleted/1, big_boot_embedded/1, native_early_modules/1, get_mode/1, normalized_paths/1]). -export([init_per_testcase/2, end_per_testcase/2, init_per_suite/1, end_per_suite/1]). %% error_logger -export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2]). -export([compile_load/4]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,5}}]. all() -> [set_path, get_path, add_path, add_paths, del_path, replace_path, load_file, load_abs, ensure_loaded, delete, purge, purge_many_exits, soft_purge, is_loaded, all_loaded, load_binary, dir_req, object_code, set_path_file, upgrade, sticky_dir, pa_pz_option, add_del_path, dir_disappeared, ext_mod_dep, clash, where_is_file, purge_stacktrace, mult_lib_roots, bad_erl_libs, code_archive, code_archive2, on_load, on_load_binary, on_load_embedded, on_load_errors, on_load_update, on_load_purge, on_load_self_call, on_load_pending, on_load_deleted, big_boot_embedded, native_early_modules, get_mode, normalized_paths]. groups() -> []. init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. init_per_suite(Config) -> %% The compiler will no longer create a Beam file if %% the module name does not match the filename, so %% we must compile to a binary and write the Beam file %% ourselves. Dir = filename:dirname(code:which(?MODULE)), File = filename:join(Dir, "code_a_test"), {ok,code_b_test,Code} = compile:file(File, [binary]), ok = file:write_file(File++".beam", Code), Config. end_per_suite(Config) -> Config. init_per_testcase(big_boot_embedded, Config) -> case catch crypto:start() of ok -> init_per_testcase(do_big_boot_embedded, Config); _Else -> {skip, "Needs crypto!"} end; init_per_testcase(_Func, Config) -> P = code:get_path(), [{code_path, P}|Config]. end_per_testcase(TC, Config) when TC == mult_lib_roots; TC == big_boot_embedded -> {ok, HostName} = inet:gethostname(), NodeName = list_to_atom(atom_to_list(TC)++"@"++HostName), test_server:stop_node(NodeName), end_per_testcase(Config); end_per_testcase(_Func, Config) -> end_per_testcase(Config). end_per_testcase(Config) -> code:purge(code_b_test), P=proplists:get_value(code_path, Config), true=code:set_path(P), P=code:get_path(), ok. set_path(Config) when is_list(Config) -> P = code:get_path(), NonExDir = filename:join(proplists:get_value(priv_dir, Config), test_server:temp_name("hej")), {'EXIT',_} = (catch code:set_path({a})), {error, bad_directory} = (catch code:set_path([{a}])), {error, bad_directory} = code:set_path(NonExDir), P = code:get_path(), % still the same path. true = code:set_path(P), % set the same path again. P = code:get_path(), % still the same path. LibDir = code:lib_dir(), true = code:set_path([LibDir | P]), [LibDir | P] = code:get_path(), true = code:set_path([LibDir]), [LibDir] = code:get_path(), ok. get_path(Config) when is_list(Config) -> P = code:get_path(), %% test that all directories are strings (lists). [] = lists:filter(fun (Dir) when is_list(Dir) -> false; (_) -> true end, P), ok. add_path(Config) when is_list(Config) -> P = code:get_path(), {'EXIT',_} = (catch code:add_path({})), {'EXIT',_} = (catch code:add_patha({})), {'EXIT',_} = (catch code:add_pathz({})), {error, bad_directory} = code:add_path("xyz"), {error, bad_directory} = code:add_patha("xyz"), {error, bad_directory} = code:add_pathz("xyz"), LibDir = code:lib_dir(), true = code:add_path(LibDir), LibDir = lists:last(code:get_path()), code:set_path(P), true = code:add_pathz(LibDir), LibDir = lists:last(code:get_path()), code:set_path(P), true = code:add_patha(LibDir), [LibDir|_] = code:get_path(), code:set_path(P), ok. add_paths(Config) when is_list(Config) -> P = code:get_path(), ok = code:add_paths([{}]), ok = code:add_pathsa([{}]), ok = code:add_pathsz([{}]), ok = code:add_paths(["xyz"]), ok = code:add_pathsa(["xyz"]), ok = code:add_pathsz(["xyz"]), P = code:get_path(), % check that no directory is added. LibDir = code:lib_dir(), ok = code:add_paths([LibDir]), LibDir = lists:last(code:get_path()), code:set_path(P), ok = code:add_pathsz([LibDir]), LibDir = lists:last(code:get_path()), code:set_path(P), ok = code:add_pathsa([LibDir]), [LibDir|P] = code:get_path(), code:set_path(P), RootDir = code:root_dir(), Res = P ++ [LibDir, RootDir], ok = code:add_paths([LibDir, RootDir]), Res = code:get_path(), code:set_path(P), ok = code:add_pathsz([LibDir, RootDir]), Res = code:get_path(), code:set_path(P), ok = code:add_pathsa([LibDir, RootDir]), [RootDir, LibDir|P] = code:get_path(), code:set_path(P), ok = code:add_paths([LibDir, "xyz"]), Res1 = P ++ [LibDir], Res1 = code:get_path(), code:set_path(P), ok = code:add_pathsz([LibDir, "xyz"]), Res1 = code:get_path(), code:set_path(P), ok = code:add_pathsa([LibDir, "xyz"]), [LibDir|P] = code:get_path(), code:set_path(P), ok. del_path(Config) when is_list(Config) -> P = code:get_path(), try del_path_1(P) after code:set_path(P) end. del_path_1(P) -> io:format("Initial code:get_path()=~p~n",[P]), {'EXIT',_} = (catch code:del_path(3)), false = code:del_path(my_dummy_name), false = code:del_path("/kdlk/my_dummy_dir"), Dir = filename:join([code:lib_dir(kernel),"ebin"]), io:format("kernel dir: ~p~n",[Dir]), true = code:del_path(kernel), NewP = code:get_path(), io:format("Path after removing 'kernel':~p~n",[NewP]), ReferenceP = lists:delete(Dir,P), io:format("Reference path:~p~n",[ReferenceP]), NewP = ReferenceP, % check that dir is deleted code:set_path(P), %% An superfluous "/" should also work. true = code:del_path("kernel/"), NewP = ReferenceP, % check that dir is deleted code:set_path(P), true = code:del_path(Dir), NewP1 = code:get_path(), NewP1 = lists:delete(Dir,P), % check that dir is deleted ok. replace_path(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), P = code:get_path(), {'EXIT',_} = (catch code:replace_path(3,"")), {error, bad_name} = code:replace_path(dummy_name,""), {error, bad_name} = code:replace_path(kernel, "/kdlk/my_dummy_dir"), {error, bad_directory} = code:replace_path(kernel, "/kdlk/kernel-1.2"), P = code:get_path(), % Check that path is not changed. ok = file:set_cwd(PrivDir), %% Replace an existing application. file:make_dir("./kernel-2.11"), {ok, Cwd} = file:get_cwd(), NewDir = Cwd ++ "/kernel-2.11", true = code:replace_path(kernel, NewDir), NewDir = code:lib_dir(kernel), true = code:set_path(P), %Reset path ok = file:del_dir("./kernel-2.11"), %% Add a completly new application. NewAppName = 'blurf_blarfer', NewAppDir = filename:join(Cwd, atom_to_list(NewAppName) ++ "-6.33.1"), ok = file:make_dir(NewAppDir), true = code:replace_path(NewAppName, NewAppDir), NewAppDir = code:lib_dir(NewAppName), NewAppDir = lists:last(code:get_path()), true = code:set_path(P), %Reset path ok = file:del_dir(NewAppDir), ok. %% OTP-3977. dir_disappeared(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), Dir = filename:join(PrivDir, "temp"), ok = file:make_dir(Dir), true = code:add_path(Dir), ok = file:del_dir(Dir), non_existing = code:which(bubbelskrammel), ok. load_file(Config) when is_list(Config) -> {error, nofile} = code:load_file(duuuumy_mod), {error, badfile} = code:load_file(code_a_test), {'EXIT', _} = (catch code:load_file(123)), {module, code_b_test} = code:load_file(code_b_test), TestDir = test_dir(), code:stick_dir(TestDir), {error, sticky_directory} = code:load_file(code_b_test), code:unstick_dir(TestDir), ok. test_dir() -> filename:dirname(code:which(?MODULE)). load_abs(Config) when is_list(Config) -> TestDir = test_dir(), {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), {'EXIT', _} = (catch code:load_abs({})), {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), code:stick_dir(TestDir), {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), code:unstick_dir(TestDir), ok. ensure_loaded(Config) when is_list(Config) -> {module, lists} = code:ensure_loaded(lists), case init:get_argument(mode) of {ok, [["embedded"]]} -> {error, embedded} = code:ensure_loaded(code_b_test), {error, badarg} = code:ensure_loaded(34), ok; _ -> {error, nofile} = code:ensure_loaded(duuuumy_mod), {error, badfile} = code:ensure_loaded(code_a_test), {'EXIT', _} = (catch code:ensure_loaded(34)), {module, code_b_test} = code:ensure_loaded(code_b_test), {module, code_b_test} = code:ensure_loaded(code_b_test), ok end. delete(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), code:purge(code_b_test), Pid = code_b_test:do_spawn(), true = code:delete(code_b_test), {'EXIT',_} = (catch code:delete(122)), false = code_b_test:check_exit(Pid), false = code:delete(code_b_test), false = code_b_test:check_exit(Pid), exit(Pid,kill), true = code_b_test:check_exit(Pid), false = code:delete(code_b_test), code:purge(code_b_test), process_flag(trap_exit, OldFlag), ok. purge(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), code:purge(code_b_test), {'EXIT',_} = (catch code:purge({})), false = code:purge(code_b_test), Pid = code_b_test:do_spawn(), true = code:delete(code_b_test), false = code_b_test:check_exit(Pid), true = code:purge(code_b_test), true = code_b_test:check_exit(Pid), process_flag(trap_exit, OldFlag), ok. purge_many_exits(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), code:purge(code_b_test), {'EXIT',_} = (catch code:purge({})), CodePurgeF = fun(M, Exp) -> Exp = code:purge(M) end, purge_many_exits_do(CodePurgeF), %% Let's repeat test for erlang:purge_module as it does the same thing %% now in erts-8.0 (except for return value). ErlangPurgeF = fun(M, _Exp) -> erlang:purge_module(M) end, purge_many_exits_do(ErlangPurgeF), process_flag(trap_exit, OldFlag), ok. purge_many_exits_do(PurgeF) -> false = code:purge(code_b_test), TPids = lists:map(fun (_) -> {code_b_test:do_spawn(), spawn_link(fun () -> receive after infinity -> ok end end)} end, lists:seq(1, 1000)), %% Give them time to start... receive after 1000 -> ok end, true = code:delete(code_b_test), lists:foreach(fun ({Pid1, Pid2}) -> true = erlang:is_process_alive(Pid1), false = code_b_test:check_exit(Pid1), true = erlang:is_process_alive(Pid2) end, TPids), PurgeF(code_b_test, true), lists:foreach(fun ({Pid1, Pid2}) -> false = erlang:is_process_alive(Pid1), true = code_b_test:check_exit(Pid1), true = erlang:is_process_alive(Pid2), exit(Pid2, kill) end, TPids), lists:foreach(fun ({_Pid1, Pid2}) -> receive {'EXIT', Pid2, _} -> ok end end, TPids). soft_purge(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), code:purge(code_b_test), {'EXIT',_} = (catch code:soft_purge(23)), true = code:soft_purge(code_b_test), Pid = code_b_test:do_spawn(), true = code:delete(code_b_test), false = code_b_test:check_exit(Pid), false = code:soft_purge(code_b_test), false = code_b_test:check_exit(Pid), exit(Pid,kill), true = code_b_test:check_exit(Pid), true = code:soft_purge(code_b_test), process_flag(trap_exit, OldFlag), ok. is_loaded(Config) when is_list(Config) -> code:purge(code_b_test), code:delete(code_b_test), false = code:is_loaded(duuuuuumy_mod), {'EXIT',_} = (catch code:is_loaded(23)), {file, preloaded} = code:is_loaded(init), TestDir = test_dir(), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), {file, _Loaded} = code:is_loaded(code_b_test), code:purge(code_b_test), code:delete(code_b_test), ok. all_loaded(Config) when is_list(Config) -> case test_server:is_cover() of true -> {skip,"Cover is running"}; false -> all_loaded_1() end. all_loaded_1() -> Preloaded = [{M,preloaded} || M <- lists:sort(erlang:pre_loaded())], Loaded0 = lists:sort(code:all_loaded()), all_unique(Loaded0), Loaded1 = lists:keysort(2, Loaded0), Loaded2 = match_and_remove(Preloaded, Loaded1), ObjExt = code:objfile_extension(), [] = lists:filter(fun ({Mod,AbsName}) when is_atom(Mod), is_list(AbsName) -> Mod =/= list_to_atom(filename:basename(AbsName, ObjExt)); (_) -> true end, Loaded2), ok. match_and_remove([], List) -> List; match_and_remove([X|T1], [X|T2]) -> match_and_remove(T1, T2). all_unique([]) -> ok; all_unique([_]) -> ok; all_unique([{X,_}|[{Y,_}|_]=T]) when X < Y -> all_unique(T). load_binary(Config) when is_list(Config) -> TestDir = test_dir(), File = TestDir ++ "/code_b_test" ++ code:objfile_extension(), {ok,Bin} = file:read_file(File), {'EXIT',_} = (catch code:load_binary(12, File, Bin)), {'EXIT',_} = (catch code:load_binary(code_b_test, 12, Bin)), {'EXIT',_} = (catch code:load_binary(code_b_test, File, 12)), {module, code_b_test} = code:load_binary(code_b_test, File, Bin), code:stick_dir(TestDir), {error, sticky_directory} = code:load_binary(code_b_test, File, Bin), code:unstick_dir(TestDir), code:purge(code_b_test), code:delete(code_b_test), ok. upgrade(Config) -> DataDir = proplists:get_value(data_dir, Config), T = case erlang:system_info(hipe_architecture) of undefined -> [beam]; _ -> case hipe:llvm_support_available() of false -> [beam,hipe]; true -> [beam,hipe,hipe_llvm] end end, [upgrade_do(DataDir, Client, T) || Client <- T], ok. upgrade_do(DataDir, Client, T) -> compile_load(upgrade_client, DataDir, undefined, Client), [upgrade_client:run(DataDir, U1, U2, O1, O2) || U1<-T, U2<-T, O1<-T, O2<-T], ok. compile_load(Mod, Dir, Ver, CodeType) -> erlang:display({"{{{{{{{{{{{{{{{{Loading",Mod,Ver,CodeType}), Version = case Ver of undefined -> io:format("Compiling '~p' as ~p\n", [Mod, CodeType]), []; _ -> io:format("Compiling version ~p of '~p' as ~p\n", [Ver, Mod, CodeType]), [{d,list_to_atom("VERSION_" ++ integer_to_list(Ver))}] end, Target = case CodeType of beam -> []; hipe -> [native]; hipe_llvm -> [native,{hipe,to_llvm}] end, CompOpts = [binary, report] ++ Target ++ Version, Src = filename:join(Dir, atom_to_list(Mod) ++ ".erl"), T1 = erlang:now(), {ok,Mod,Code} = compile:file(Src, CompOpts), T2 = erlang:now(), ObjFile = filename:basename(Src,".erl") ++ ".beam", {module,Mod} = code:load_binary(Mod, ObjFile, Code), T3 = erlang:now(), io:format("Compile time ~p ms, Load time ~p ms\n", [timer:now_diff(T2,T1) div 1000, timer:now_diff(T3,T2) div 1000]), erlang:display({"}}}}}}}}}}}}}}}Loaded",Mod,Ver,CodeType}), ok. dir_req(Config) when is_list(Config) -> {ok,[[Root0]]} = init:get_argument(root), Root = filename:join([Root0]), % Normalised form. Root = code:root_dir(), LibDir = Root ++ "/lib", LibDir = code:lib_dir(), code:compiler_dir(), {error, bad_name} = code:lib_dir(duuumy), KernLib = code:lib_dir(kernel), Priv = KernLib ++ "/priv", Priv = code:priv_dir(kernel), {error, bad_name} = code:priv_dir(duuumy), ok. object_code(Config) when is_list(Config) -> TestDir = test_dir(), P = code:get_path(), P = code:get_path(), code:add_path(TestDir), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), LoadedFile = filename:absname(TestDir ++ "/code_b_test" ++ code:objfile_extension()), case code:get_object_code(code_b_test) of {code_b_test,Bin,LoadedFile} when is_binary(Bin) -> ok end, code:purge(code_b_test), code:delete(code_b_test), error = code:get_object_code(dddddddduuuuuuumy), {'EXIT',_} = (catch code:get_object_code(23)), code:set_path(P), P=code:get_path(), ok. %% Test that set_path does not accept %% files as pathnames (known previous bug) set_path_file(Config) when is_list(Config) -> File=filename:join(proplists:get_value(priv_dir, Config), "testfil"), ok=file:write_file(File, list_to_binary("lite data")), {error, bad_directory}=code:set_path([File]). %% Test that a module with the same name as a module in %% a sticky directory cannot be loaded. sticky_dir(Config) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(sticky_dir, slave, [{args,"-pa "++Pa}]), Mods = [code,lists,erlang,init], OutDir = filename:join(proplists:get_value(priv_dir, Config), sticky_dir), _ = file:make_dir(OutDir), Ret = rpc:call(Node, erlang, apply, [fun sticky_compiler/2,[Mods,OutDir]]), case Ret of [] -> ok; Other -> io:format("~p\n", [Other]), ct:fail(failed) end, test_server:stop_node(Node), ok. sticky_compiler(Files, PrivDir) -> code:add_patha(PrivDir), Rets = [do_sticky_compile(F, PrivDir) || F <- Files], [R || R <- Rets, R =/= ok]. do_sticky_compile(Mod, Dir) -> %% Make sure that the module is loaded. A module being sticky %% only prevents it from begin reloaded, not from being loaded %% from the wrong place to begin with. Mod = Mod:module_info(module), File = filename:append(Dir, atom_to_list(Mod)), Src = io_lib:format("-module(~s).\n" "-export([test/1]).\n" "test(me) -> fail.\n", [Mod]), ok = file:write_file(File++".erl", Src), case c:c(File, [{outdir,Dir}]) of {ok,Module} -> Module:test(me); {error,sticky_directory} -> ok end. %% Test that the -pa and -pz options work as expected. pa_pz_option(Config) when is_list(Config) -> DDir = proplists:get_value(data_dir,Config), PaDir = filename:join(DDir,"pa"), PzDir = filename:join(DDir,"pz"), {ok, Node}=test_server:start_node(pa_pz1, slave, [{args, "-pa " ++ PaDir ++ " -pz " ++ PzDir}]), Ret=rpc:call(Node, code, get_path, []), [PaDir|Paths] = Ret, [PzDir|_] = lists:reverse(Paths), test_server:stop_node(Node), {ok, Node2}=test_server:start_node(pa_pz2, slave, [{args, "-mode embedded " ++ "-pa " ++ PaDir ++ " -pz " ++ PzDir}]), Ret2=rpc:call(Node2, code, get_path, []), [PaDir|Paths2] = Ret2, [PzDir|_] = lists:reverse(Paths2), test_server:stop_node(Node2). %% add_path, del_path should not cause priv_dir(App) to fail. add_del_path(Config) when is_list(Config) -> DDir = proplists:get_value(data_dir,Config), Dir1 = filename:join(DDir,"dummy_app-1.0/ebin"), Dir2 = filename:join(DDir,"dummy_app-2.0/ebin"), code:add_patha(Dir1), PrivDir1 = filename:join(DDir,"dummy_app-1.0/priv"), PrivDir1 = code:priv_dir(dummy_app), code:add_path(Dir2), % put last in path PrivDir1 = code:priv_dir(dummy_app), code:del_path(Dir2), PrivDir1 = code:priv_dir(dummy_app), ok. clash(Config) when is_list(Config) -> DDir = proplists:get_value(data_dir,Config)++"clash/", P = code:get_path(), %% test non-clashing entries true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"zork-0.8/ebin"), ct:capture_start(), ok = code:clash(), ct:capture_stop(), [OKMsg|_] = ct:capture_get(), true = lists:prefix("** Found 0 name clashes", OKMsg), true = code:set_path(P), %% test clashing entries true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"foobar-0.1.ez/foobar-0.1/ebin"), ct:capture_start(), ok = code:clash(), ct:capture_stop(), [ClashMsg|_] = ct:capture_get(), {match, [" hides "]} = re:run(ClashMsg, "\\*\\* .*( hides ).*", [{capture,all_but_first,list}]), true = code:set_path(P), %% test "Bad path can't read" Priv = proplists:get_value(priv_dir, Config), TmpEzFile = Priv++"foobar-0.tmp.ez", {ok, _} = file:copy(DDir++"foobar-0.1.ez", TmpEzFile), true = code:add_path(TmpEzFile++"/foobar-0.1/ebin"), case os:type() of {win32,_} -> %% The file wont be deleted on windows until it's closed, why we %% need to rename instead. ok = file:rename(TmpEzFile,TmpEzFile++".moved"); _ -> ok = file:delete(TmpEzFile) end, ct:capture_start(), ok = code:clash(), ct:capture_stop(), [BadPathMsg|_] = ct:capture_get(), true = lists:prefix("** Bad path can't read", BadPathMsg), true = code:set_path(P), file:delete(TmpEzFile++".moved"), %% Only effect on windows ok. %% Every module that the code_server uses should be preloaded, %% this test case verifies that. ext_mod_dep(Config) when is_list(Config) -> xref:start(s), xref:set_default(s, [{verbose,false},{warnings,false}, {builtins,true},{recurse,true}]), xref:set_library_path(s, code:get_path()), xref:add_directory(s, filename:join(code:lib_dir(kernel),"ebin")), xref:add_directory(s, filename:join(code:lib_dir(stdlib),"ebin")), case catch ext_mod_dep2() of {'EXIT', Reason} -> xref:stop(s), exit(Reason); Else -> xref:stop(s), case Else of ok -> ok; _ -> ct:fail(Else) end end. ext_mod_dep2() -> Exports0 = code_server:module_info(exports) -- [{module_info,0},{module_info,1}], Exports = [{code_server,M,A} || {M,A} <- Exports0], case analyse(Exports, [], [], 0) of {_Visited,0} -> ok; {_Visited,ErrCnt} -> {not_verified,ErrCnt} end. analyse([], [], Visited, ErrCnt) -> {Visited,ErrCnt}; analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> %% The code_server has been granted to use the following modules, %% These modules should be loaded by code.erl before %% the code_server is started. OK = [erlang, os, prim_file, erl_prim_loader, init, ets, code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, erts_code_purger, prim_zip, zlib], ErrCnt1 = case lists:member(M, OK) or erlang:is_builtin(M,F,A) of true -> 0; false -> check_funs(This, Path) end, {Visited, ErrCnt1+ErrCnt0}; analyse([MFA|R], Path, Visited0, ErrCnt0) -> case lists:member(MFA,Visited0) of false -> {Visited,ErrCnt1} = analyse2(MFA, Path, Visited0), analyse(R, Path, Visited, ErrCnt1+ErrCnt0); true -> analyse(R, Path, Visited0, ErrCnt0) end. analyse2(MFA = {'$M_EXPR',_, _}, Path, Visited0) -> analyse([], [MFA|Path], Visited0, 0); analyse2(MFA={_,_,_}, Path, Visited0) -> {ok, FL} = xref:analyze(s,{call,MFA}), analyse(FL, [MFA|Path], my_usort([MFA|Visited0]), 0). %%%% We need to check these manually... %% fun's are ok as long as they are defined locally. check_funs({'$M_EXPR','$F_EXPR',_}, [{unicode,characters_to_binary_int,3}, {unicode,characters_to_binary,3}, {filename,filename_string_to_binary,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{unicode,ml_map,3}, {unicode,characters_to_binary_int,3}, {unicode,characters_to_binary,3}, {filename,filename_string_to_binary,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{unicode,do_o_binary2,2}, {unicode,do_o_binary,2}, {unicode,o_trans,1}, {unicode,characters_to_binary_int,3}, {unicode,characters_to_binary,3}, {filename,filename_string_to_binary,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{code_server,do_mod_call,4}, {code_server,handle_call,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{lists,flatmap,2}, {lists,concat,1}, {code_server,load_abs,4}, {code_server,handle_call,3}, {code_server,loop,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{lists,foreach,2}, {code_server,stick_dir,3}, {code_server,handle_call,3}, {code_server,loop,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,all,2}, {code_server,is_numstr,1}, {code_server,is_vsn,1}, {code_server,vsn_to_num,1}, {code_server,create_bundle,2}, {code_server,choose_bundles,1}, {code_server,make_path,2}, {code_server,get_user_lib_dirs_1,1}, {code_server,get_user_lib_dirs,0}, {code_server,init,3}, {code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,filter,2}, {code_server,try_archive_subdirs,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{erlang,apply,2}, {erlang,spawn_link,1}, {code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{erlang,spawn_link,1},{code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{hipe_unified_loader,write_words,3} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{hipe_unified_loader,patch_label_or_labels,4} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{hipe_unified_loader,sort_and_write,5} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{lists,foldl,3}, {hipe_unified_loader,sort_and_write,5} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,foreach,2}, {hipe_unified_loader,patch_consts,4} | _]) -> 0; check_funs({'$M_EXPR',warning_msg,2}, [{code_server,finish_on_load_report,2} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{code_server,run,2}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{code_server,handle_on_load,5}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{code_server,handle_pending_on_load,4}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, [{code_server,finish_on_load_2,3}|_]) -> 0; %% This is cheating! /raimo %% %% check_funs(This = {M,_,_}, Path) -> %% case catch atom_to_list(M) of %% [$h,$i,$p,$e | _] -> %% io:format("hipe_module_ignored(~p, ~p)~n", [This, Path]), %% 0; %% _ -> %% io:format("not_verified(~p, ~p)~n", [This, Path]), %% 1 %% end; check_funs(This, Path) -> io:format("not_verified(~p, ~p)~n", [This, Path]), 1. my_usort(List) -> lists:reverse(uniq(lists:sort(List),[])). uniq([],A) -> A; uniq([H|T],[]) -> uniq(T,[H]); uniq([H|T],[H|_]=A) -> uniq(T,A); uniq([H|T],A) -> uniq(T,[H|A]). where_is_file(Config) when is_list(Config) -> {T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]), io:format("Load time: ~w ms~n", [T]), KernelEbinDir = filename:dirname(KernelBeamFile), AppFile = filename:join(KernelEbinDir, "kernel.app"), AppFile = code:where_is_file("kernel.app"), non_existing = code:where_is_file("kernel"), % no such file ok. %% Test that stacktrace is deleted when purging a referred module. purge_stacktrace(Config) when is_list(Config) -> code:purge(code_b_test), try code_b_test:call(fun(b) -> ok end, a) catch error:function_clause -> code:load_file(code_b_test), case erlang:get_stacktrace() of [{?MODULE,_,[a],_}, {code_b_test,call,2,_}, {?MODULE,purge_stacktrace,1,_}|_] -> false = code:purge(code_b_test), [] = erlang:get_stacktrace() end end, try code_b_test:call(nofun, 2) catch error:function_clause -> code:load_file(code_b_test), case erlang:get_stacktrace() of [{code_b_test,call,[nofun,2],_}, {?MODULE,purge_stacktrace,1,_}|_] -> false = code:purge(code_b_test), [] = erlang:get_stacktrace() end end, Args = [erlang,error,[badarg]], try code_b_test:call(erlang, error, [badarg,Args]) catch error:badarg -> code:load_file(code_b_test), case erlang:get_stacktrace() of [{code_b_test,call,Args,_}, {?MODULE,purge_stacktrace,1,_}|_] -> false = code:purge(code_b_test), [] = erlang:get_stacktrace() end end, ok. mult_lib_roots(Config) when is_list(Config) -> DataDir = filename:join(proplists:get_value(data_dir, Config), "mult_lib_roots"), mult_lib_compile(DataDir, "my_dummy_app-b/ebin/lists"), mult_lib_compile(DataDir, "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), %% Set up ERL_LIBS and start a slave node. ErlLibs = filename:join(DataDir, "first_root") ++ mult_lib_sep() ++ filename:join(DataDir, "second_root"), {ok,Node} = test_server:start_node(mult_lib_roots, slave, [{args,"-env ERL_LIBS "++ErlLibs}]), Path0 = rpc:call(Node, code, get_path, []), ["."|Path1] = Path0, [Kernel|Path2] = Path1, [Stdlib|Path3] = Path2, mult_lib_verify_lib(Kernel, "kernel"), mult_lib_verify_lib(Stdlib, "stdlib"), [Lib1,Lib2,Lib3,Lib4,Lib5|Path] = Path3, ["first_root/my_dummy_app-a/ebin", "first_root/my_dummy_app-b/ebin", "first_root/my_dummy_app-c/ebin", "second_root/my_dummy_app-d/ebin", "second_root/my_dummy_app-e/ebin"] = [mult_lib_remove_prefix(E, DataDir) || E <- lists:sort([Lib1,Lib2,Lib3,Lib4,Lib5])], io:format("~p\n", [Path]), true = rpc:call(Node, code_SUITE_mult_root_module, works_fine, []), ok. mult_lib_compile(Root, Last) -> Mod = list_to_atom(filename:basename(Last)), Name = filename:join([Root,"first_root",Last]), Dir = filename:dirname(Name), {ok,Mod} = compile:file(Name, [report,{outdir,Dir}]), ok. mult_lib_sep() -> case os:type() of {win32,_} -> ";"; _ -> ":" end. mult_lib_verify_lib(Path, Expected) -> Dir = filename:basename(filename:dirname(Path)), true = lists:prefix(Expected, Dir). mult_lib_remove_prefix([H|T1], [H|T2]) -> mult_lib_remove_prefix(T1, T2); mult_lib_remove_prefix([$/|T], []) -> T. bad_erl_libs(Config) when is_list(Config) -> {ok,Node} = test_server:start_node(bad_erl_libs, slave, []), Code = rpc:call(Node,code,get_path,[]), test_server:stop_node(Node), {ok,Node2} = test_server:start_node(bad_erl_libs, slave, [{args,"-env ERL_LIBS /no/such/dir"}]), Code2 = rpc:call(Node,code,get_path,[]), test_server:stop_node(Node2), %% Test that code path is not affected by the faulty ERL_LIBS Code = Code2, ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Create an archive file containing an application and make use of it. code_archive(Config) when is_list(Config) -> do_code_archive(Config, "code_archive_libs", false). code_archive2(Config) when is_list(Config) -> do_code_archive(Config, "code_archive_libs2", true). do_code_archive(Config, Root, StripVsn) when is_list(Config) -> %% Copy the orig files to priv_dir DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), App = code_archive_dict, VsnBase = atom_to_list(App) ++ "-1.0", Base = case StripVsn of true -> atom_to_list(App); false -> VsnBase end, Ext = init:archive_extension(), RootDir = filename:join([PrivDir, Root]), ok = file:make_dir(RootDir), Archive = filename:join([RootDir, VsnBase ++ Ext]), {ok, _} = zip:create(Archive, [VsnBase], [{compress, []}, {cwd, DataDir}]), {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]), case StripVsn of true -> ok = file:rename(filename:join([PrivDir, VsnBase]), filename:join([PrivDir, Base])); false -> ok end, io:format("DEBUG: ~p\n", [?LINE]), %% Compile the code ok = compile_app(PrivDir, Base), %% Create the archive ok = file:delete(Archive), {ok, _} = zip:create(Archive, [Base], [{compress, []}, {cwd, PrivDir}]), %% Create a directory and a file outside of the archive. OtherFile = filename:join([RootDir,VsnBase,"other","other.txt"]), OtherContents = ?MODULE:module_info(md5), filelib:ensure_dir(OtherFile), ok = file:write_file(OtherFile, OtherContents), %% Set up ERL_LIBS and start a slave node. {ok, Node} = test_server:start_node(code_archive, slave, [{args,"-env ERL_LIBS " ++ RootDir}]), CodePath = rpc:call(Node, code, get_path, []), AppEbin = filename:join([Archive, Base, "ebin"]), io:format("AppEbin: ~p\n", [AppEbin]), io:format("CodePath: ~p\n", [CodePath]), io:format("Archive: ~p\n", [erl_prim_loader:read_file_info(Archive)]), true = lists:member(AppEbin, CodePath), %% Start the app ok = rpc:call(Node, application, start, [App]), %% Get the lib dir for the app. AppLibDir = rpc:call(Node, code, lib_dir, [App]), io:format("AppLibDir: ~p\n", [AppLibDir]), AppLibDir = filename:join(RootDir, VsnBase), %% Access the app priv dir AppPrivDir = rpc:call(Node, code, priv_dir, [App]), AppPrivFile = filename:join([AppPrivDir, "code_archive.txt"]), io:format("AppPrivFile: ~p\n", [AppPrivFile]), {ok, _Bin, _} = rpc:call(Node, erl_prim_loader, get_file, [AppPrivFile]), %% Read back the other text file. OtherDirPath = rpc:call(Node, code, lib_dir, [App,other]), OtherFilePath = filename:join(OtherDirPath, "other.txt"), io:format("OtherFilePath: ~p\n", [OtherFilePath]), {ok, OtherContents, _} = rpc:call(Node, erl_prim_loader, get_file, [OtherFilePath]), %% Use the app Tab = code_archive_tab, Key = foo, Val = bar, {ok, _Pid} = rpc:call(Node, App, new, [Tab]), error = rpc:call(Node, App, find, [Tab, Key]), ok = rpc:call(Node, App, store, [Tab, Key, Val]), {ok, Val} = rpc:call(Node, App, find, [Tab, Key]), ok = rpc:call(Node, App, erase, [Tab, Key]), error = rpc:call(Node, App, find, [Tab, Key]), ok = rpc:call(Node, App, erase, [Tab]), test_server:stop_node(Node), ok. compile_app(TopDir, AppName) -> AppDir = filename:join([TopDir, AppName]), SrcDir = filename:join([AppDir, "src"]), OutDir = filename:join([AppDir, "ebin"]), {ok, Files} = file:list_dir(SrcDir), compile_files(Files, SrcDir, OutDir). compile_files([File | Files], SrcDir, OutDir) -> case filename:extension(File) of ".erl" -> AbsFile = filename:join([SrcDir, File]), case compile:file(AbsFile, [{outdir, OutDir}]) of {ok, _Mod} -> compile_files(Files, SrcDir, OutDir); Error -> {compilation_error, AbsFile, OutDir, Error} end; _ -> compile_files(Files, SrcDir, OutDir) end; compile_files([], _, _) -> ok. %% Test that a boot file with (almost) all of OTP can be used to start an %% embeddedd system. big_boot_embedded(Config) when is_list(Config) -> {BootArg,AppsInBoot} = create_big_boot(Config), {ok, Node} = test_server:start_node(big_boot_embedded, slave, [{args,"-boot "++BootArg++" -mode embedded"}]), RemoteNodeApps = [ {X,Y} || {X,_,Y} <- rpc:call(Node,application,loaded_applications,[]) ], true = lists:sort(AppsInBoot) =:= lists:sort(RemoteNodeApps), ok. on_load(Config) when is_list(Config) -> Master = on_load_test_case_process, Data = filename:join([proplists:get_value(data_dir, Config),"on_load"]), ok = file:set_cwd(Data), up_to_date = make:all([{d,'MASTER',Master}]), %% Register a name for this process. register(Master, self()), {_,Ref} = spawn_monitor(fun() -> exit(on_load_a:data()) end), receive {on_load_a,start} -> ok end, receive {on_load_b,start} -> ok end, receive {on_load_c,PidC} -> ok end, Refs = on_load_massive_spawn(lists:seq(1, 50)), receive after 7 -> ok end, PidC ! go, KernelLibDir = code:lib_dir(kernel), receive {on_load_c,done} -> ok end, receive {on_load_b,done} -> ok end, receive {on_load_a,KernelLibDir} -> ok end, receive {'DOWN',Ref,process,_,Res} -> [a,b,c] = Res end, on_load_wait_for_all(Refs), receive Any -> ct:fail({unexpected,Any}) after 10 -> ok end. on_load_massive_spawn([_|T]) -> {_,Ra} = spawn_monitor(fun() -> [a,b,c] = on_load_a:data() end), {_,Rb} = spawn_monitor(fun() -> [b,c] = on_load_b:data() end), {_,Rc} = spawn_monitor(fun() -> [c] = on_load_c:data() end), [Ra,Rb,Rc|on_load_massive_spawn(T)]; on_load_massive_spawn([]) -> []. on_load_wait_for_all([Ref|T]) -> receive {'DOWN',Ref,process,_,normal} -> on_load_wait_for_all(T) end; on_load_wait_for_all([]) -> ok. on_load_binary(_) -> Master = on_load_binary_test_case_process, register(Master, self()), %% Construct, compile and pretty-print. Mod = ?FUNCTION_NAME, File = atom_to_list(Mod) ++ ".erl", Tree = ?Q(["-module('@Mod@').\n", "-export([ok/0]).\n", "-on_load({init,0}).\n", "init() ->\n", " '@Master@' ! {on_load_binary,self()},\n", " receive go -> ok end.\n", "ok() -> true.\n"]), {ok,Mod,Bin} = merl:compile(Tree), merl:print(Tree), {Pid1,Ref1} = spawn_monitor(fun() -> code:load_binary(Mod, File, Bin), true = on_load_binary:ok() end), receive {Mod,OnLoadPid} -> ok end, {Pid2,Ref2} = spawn_monitor(fun() -> true = on_load_binary:ok() end), erlang:yield(), OnLoadPid ! go, receive {'DOWN',Ref1,process,Pid1,Exit1} -> ok end, receive {'DOWN',Ref2,process,Pid2,Exit2} -> ok end, normal = Exit1, normal = Exit2, true = code:delete(on_load_binary), false = code:purge(on_load_binary), ok. on_load_embedded(Config) when is_list(Config) -> try on_load_embedded_1(Config) catch throw:{skip,_}=Skip -> Skip end. on_load_embedded_1(Config) -> DataDir = proplists:get_value(data_dir, Config), %% Link the on_load_app application into the lib directory. LibRoot = code:lib_dir(), LinkName = filename:join(LibRoot, "on_load_app-1.0"), OnLoadApp = filename:join(DataDir, "on_load_app-1.0"), del_link(LinkName), io:format("LinkName :~p, OnLoadApp: ~p~n",[LinkName,OnLoadApp]), case file:make_symlink(OnLoadApp, LinkName) of {error,enotsup} -> throw({skip,"Support for symlinks required"}); {error,eperm} -> %% On Windows, we may not have permissions to create symlinks. throw({skip,"Support for symlinks required"}); ok -> ok end, %% Compile the code. OnLoadAppEbin = filename:join(LinkName, "ebin"), {ok,_ } = compile:file(filename:join([OnLoadApp,"src", "on_load_embedded"]), [{outdir,OnLoadAppEbin}]), %% Create and compile a boot file. true = code:add_pathz(OnLoadAppEbin), Options = case is_source_dir() of true -> [local]; false -> [] end, BootScript = create_boot(Config, Options), true = code:del_path(OnLoadAppEbin), %% Start the node and check that the on_load function was run. {ok,Node} = start_node(on_load_embedded, "-mode embedded -boot " ++ BootScript), ok = rpc:call(Node, on_load_embedded, status, []), %% Clean up. stop_node(Node), ok = del_link(LinkName). del_link(LinkName) -> case file:delete(LinkName) of {error,eperm} -> file:del_dir(LinkName); Other -> Other end. create_boot(Config, Options) -> {ok, OldDir} = file:get_cwd(), {LatestDir,LatestName} = create_script(Config), ok = file:set_cwd(LatestDir), ok = systools:make_script(LatestName, Options), ok = file:set_cwd(OldDir), filename:join(LatestDir, LatestName). create_script(Config) -> PrivDir = proplists:get_value(priv_dir, Config), Name = PrivDir ++ "on_load_test", Apps = application_controller:which_applications(), {value,{_,_,KernelVer}} = lists:keysearch(kernel, 1, Apps), {value,{_,_,StdlibVer}} = lists:keysearch(stdlib, 1, Apps), {ok,Fd} = file:open(Name ++ ".rel", [write]), io:format(Fd, "{release, {\"Test release 3\", \"P2A\"}, \n" " {erts, \"9.42\"}, \n" " [{kernel, \"~s\"}, {stdlib, \"~s\"}," " {on_load_app, \"1.0\"}]}.\n", [KernelVer,StdlibVer]), file:close(Fd), {filename:dirname(Name),filename:basename(Name)}. create_big_boot(Config) -> {ok, OldDir} = file:get_cwd(), {Options,Local} = case is_source_dir() of true -> {[no_module_tests,local],true}; _ -> {[no_module_tests],false} end, {LatestDir,LatestName,Apps} = create_big_script(Config,Local), ok = file:set_cwd(LatestDir), ok = systools:make_script(LatestName, Options), ok = file:set_cwd(OldDir), {filename:join(LatestDir, LatestName),Apps}. %% The following apps cannot be loaded. %% hipe .app references (or can reference) files that have no %% corresponding beam file (if hipe is not enabled). filter_app("hipe",_) -> false; %% Dialyzer and typer depends on hipe filter_app("dialyzer",_) -> false; filter_app("typer",_) -> false; %% Orber requires explicit configuration filter_app("orber",_) -> false; %% cos* depends on orber filter_app("cos"++_,_) -> false; %% ic has a mod instruction in the app file but no corresponding start %% function filter_app("ic",_) -> false; %% Netconf has some dependency that I really do not understand (maybe %% like orber) filter_app("netconf",_) -> false; %% Safe has the same kind of error in the .app file as ic filter_app("safe",_) -> false; %% Comte cannot be started in the "usual" way filter_app("comte",_) -> false; %% OS_mon does not find its port program when running cerl filter_app("os_mon",true) -> false; %% erts is not a "real" app either =/ filter_app("erts",_) -> false; %% Other apps should be OK. filter_app(_,_) -> true. create_big_script(Config,Local) -> PrivDir = proplists:get_value(priv_dir, Config), Name = filename:join(PrivDir,"full_script_test"), InitialApplications=application:loaded_applications(), %% Applications left loaded by the application suite, unload them! UnloadFix=[app0,app1,app2,group_leader,app_start_error], [application:unload(Leftover) || Leftover <- UnloadFix, lists:keymember(Leftover,1,InitialApplications) ], %% Now we should have only "real" applications... [application:load(list_to_atom(Y)) || {match,[Y]} <- [re:run(X,code:lib_dir()++"/"++"([^/-]*).*/ebin", [{capture,[1],list},unicode]) || X <- code:get_path()],filter_app(Y,Local)], Apps = [ {N,V} || {N,_,V} <- application:loaded_applications()], {ok,Fd} = file:open(Name ++ ".rel", [write]), io:format(Fd, "{release, {\"Test release 3\", \"P2A\"}, \n" " {erts, \"9.42\"}, \n" " ~p}.\n", [Apps]), file:close(Fd), NewlyLoaded = application:loaded_applications() -- InitialApplications, [ application:unload(N) || {N,_,_} <- NewlyLoaded], {filename:dirname(Name),filename:basename(Name),Apps}. is_source_dir() -> filename:basename(code:lib_dir(kernel)) =:= "kernel" andalso filename:basename(code:lib_dir(stdlib)) =:= "stdlib". on_load_errors(Config) when is_list(Config) -> Master = on_load_error_test_case_process, register(Master, self()), Data = filename:join([proplists:get_value(data_dir, Config),"on_load_errors"]), ok = file:set_cwd(Data), up_to_date = make:all([{d,'MASTER',Master}]), do_on_load_error(an_atom), error_logger:add_report_handler(?MODULE, self()), do_on_load_error({something,terrible,is,wrong}), receive Any1 -> {_, "The on_load function"++_, [on_load_error, {something,terrible,is,wrong},_]} = Any1 end, do_on_load_error(fail), %Cause exception. receive Any2 -> {_, "The on_load function"++_, [on_load_error,{failed,[_|_]},_]} = Any2 end, %% There should be no more messages. receive Unexpected -> ct:fail({unexpected,Unexpected}) after 10 -> ok end, %% Make sure that the code loading functions return the correct %% error code. Simple = simple_on_load_error, SimpleList = atom_to_list(Simple), {error,on_load_failure} = code:load_file(Simple), {error,on_load_failure} = code:ensure_loaded(Simple), {ok,SimpleCode} = file:read_file("simple_on_load_error.beam"), {error,on_load_failure} = code:load_binary(Simple, "", SimpleCode), {error,on_load_failure} = code:load_abs(SimpleList), {error,on_load_failure} = code:load_abs(SimpleList, Simple), ok. do_on_load_error(ReturnValue) -> {_,Ref} = spawn_monitor(fun() -> exit(on_load_error:main()) end), receive {on_load_error,ErrorPid} -> ok end, ErrorPid ! ReturnValue, receive {'DOWN',Ref,process,_,Exit} -> {undef,[{on_load_error,main,[],_}|_]} = Exit end. on_load_update(_Config) -> {Mod,Code1} = on_load_update_code(1), {module,Mod} = code:load_binary(Mod, "", Code1), 42 = Mod:a(), 100 = Mod:b(99), 4 = erlang:trace_pattern({Mod,'_','_'}, true), {Mod,Code2} = on_load_update_code(2), {error,on_load_failure} = code:load_binary(Mod, "", Code2), 42 = Mod:a(), 100 = Mod:b(99), {'EXIT',{undef,_}} = (catch Mod:never()), 4 = erlang:trace_pattern({Mod,'_','_'}, false), {Mod,Code3} = on_load_update_code(3), {module,Mod} = code:load_binary(Mod, "", Code3), 100 = Mod:c(), {'EXIT',{undef,_}} = (catch Mod:a()), {'EXIT',{undef,_}} = (catch Mod:b(10)), {'EXIT',{undef,_}} = (catch Mod:never()), ok. on_load_update_code(Version) -> Mod = ?FUNCTION_NAME, Tree = on_load_update_code_1(Version, Mod), io:format("Version ~p", [Version]), {ok,Mod,Code} = merl:compile(Tree), merl:print(Tree), io:nl(), {Mod,Code}. on_load_update_code_1(1, Mod) -> ?Q(["-module('@Mod@').\n", "-export([a/0,b/1]).\n" "-on_load(f/0).\n", "f() -> ok.\n", "a() -> 42.\n" "b(I) -> I+1.\n"]); on_load_update_code_1(2, Mod) -> ?Q(["-module('@Mod@').\n", "-export([never/0]).\n" "-on_load(f/0).\n", "f() -> 42 = '@Mod@':a(), 1 = '@Mod@':b(0), fail.\n", "never() -> never.\n"]); on_load_update_code_1(3, Mod) -> ?Q(["-module('@Mod@').\n", "-export([c/0]).\n" "-on_load(f/0).\n", "f() -> ok.\n", "c() -> 100.\n"]). on_load_purge(_Config) -> Mod = ?FUNCTION_NAME, register(Mod, self()), Tree = ?Q(["-module('@Mod@').\n", "-on_load(f/0).\n", "loop() -> loop().\n", "f() ->\n", "'@Mod@' ! {self(),spawn(fun loop/0)},\n", "receive Ack -> Ack end.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), P = spawn(fun() -> exit(code:load_binary(Mod, "", Code)) end), monitor(process, P), receive {Pid1,Pid2} -> monitor(process, Pid2), Pid1 ! ack_and_failure, receive {'DOWN',_,process,P,Exit1} -> {error,on_load_failure} = Exit1 end, receive {'DOWN',_,process,Pid2,Exit2} -> io:format("~p\n", [Exit2]) after 10000 -> ct:fail(no_down_message) end end. on_load_self_call(_Config) -> Mod = ?FUNCTION_NAME, register(Mod, self()), Tree = ?Q(["-module('@Mod@').\n", "-export([ext/0]).\n", "-on_load(f/0).\n", "f() ->\n", " '@Mod@' ! (catch '@Mod@':ext()),\n", " ok.\n", "ext() -> good_work.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), {'EXIT',{undef,_}} = on_load_do_load(Mod, Code), good_work = on_load_do_load(Mod, Code), ok. on_load_do_load(Mod, Code) -> spawn(fun() -> {module,Mod} = code:load_binary(Mod, "", Code) end), receive Any -> Any end. on_load_pending(_Config) -> Mod = ?FUNCTION_NAME, Tree1 = ?Q(["-module('@Mod@').\n", "-on_load(f/0).\n", "f() ->\n", " register('@Mod@', self()),\n", " receive _ -> ok end.\n"]), merl:print(Tree1), {ok,Mod,Code1} = merl:compile(Tree1), Tree2 = ?Q(["-module('@Mod@').\n", "-export([t/0]).\n", "t() -> ok.\n"]), merl:print(Tree2), {ok,Mod,Code2} = merl:compile(Tree2), Self = self(), {_,Ref1} = spawn_monitor(fun() -> Self ! started1, {module,Mod} = code:load_binary(Mod, "", Code1) end), receive started1 -> ok end, timer:sleep(10), {_,Ref2} = spawn_monitor(fun() -> Self ! started2, {module,Mod} = code:load_binary(Mod, "", Code2), ok = Mod:t() end), receive started2 -> ok end, receive Unexpected -> ct:fail({unexpected,Unexpected}) after 100 -> ok end, Mod ! go, receive {'DOWN',Ref1,process,_,normal} -> ok end, receive {'DOWN',Ref2,process,_,normal} -> ok end, ok = Mod:t(), ok. on_load_deleted(_Config) -> Mod = ?FUNCTION_NAME, R0 = fun() -> Tree = ?Q(["-module('@Mod@').\n", "-on_load(f/0).\n", "f() -> ok.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), {module,Mod} = code:load_binary(Mod, "", Code) end, delete_before_reload(Mod, R0), delete_before_reload(Mod, R0), R1 = fun() -> Tree = ?Q(["-module('@Mod@').\n", "-on_load(f/0).\n", "f() -> fail.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), {error,on_load_failure} = code:load_binary(Mod, "", Code) end, delete_before_reload(Mod, R1), delete_before_reload(Mod, R1), OtherMod = list_to_atom(lists:concat([Mod,"_42"])), OtherTree = ?Q(["-module('@OtherMod@').\n"]), merl:print(OtherTree), {ok,OtherMod,OtherCode} = merl:compile(OtherTree), R2 = fun() -> RegName = 'on_load__registered_name', Tree = ?Q(["-module('@Mod@').\n", "-on_load(f/0).\n", "f() ->\n", " register('@RegName@', self()),\n", " receive _ -> ok end.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), spawn(fun() -> {module,Mod} = code:load_binary(Mod, "", Code) end), receive after 1 -> ok end, {module,OtherMod} = code:load_binary(OtherMod, "", OtherCode), RegName ! stop end, delete_before_reload(Mod, R2), ok. delete_before_reload(Mod, Reload) -> false = check_old_code(Mod), Tree1 = ?Q(["-module('@Mod@').\n", "-export([f/1]).\n", "f(Parent) ->\n", " register('@Mod@', self()),\n", " Parent ! started,\n", " receive _ -> ok end.\n"]), merl:print(Tree1), {ok,Mod,Code1} = merl:compile(Tree1), Self = self(), spawn(fun() -> {module,Mod} = code:load_binary(Mod, "", Code1), Mod:f(Self) end), receive started -> ok end, true = code:delete(Mod), true = check_old_code(Mod), Reload(), %% When loading the the module with the -on_load() function, %% the reference to the old code would be lost. Make sure that %% the old code is remembered and is still preventing the %% purge. false = code:soft_purge(Mod), %% Get rid of the old code. Mod ! stop, receive after 1 -> ok end, true = code:soft_purge(Mod), %% Unload the version of the module with the -on_load() function. true = code:delete(Mod), true = code:soft_purge(Mod), ok. %% Test that the native code of early loaded modules is loaded. native_early_modules(Config) when is_list(Config) -> case erlang:system_info(hipe_architecture) of undefined -> {skip,"Native code support is not enabled"}; Architecture -> native_early_modules_1(Architecture) end. native_early_modules_1(Architecture) -> {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), ChunkName = hipe_unified_loader:chunk_name(Architecture), NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), IsHipeCompiled = case NativeChunk of {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> true; {error, beam_lib, _} -> false end, case IsHipeCompiled of false -> {skip,"OTP apparently not configured with --enable-native-libs"}; true -> true = lists:all(fun code:is_module_native/1, [ets,file,filename,gb_sets,gb_trees, %%hipe_unified_loader, no_native as workaround lists,os]), ok end. %% Test that the mode of the code server is properly retrieved. get_mode(Config) when is_list(Config) -> interactive = code:get_mode(). %% Make sure that the paths for all loaded modules have been normalized. normalized_paths(_Config) -> do_normalized_paths(erlang:loaded()). do_normalized_paths([M|Ms]) -> case code:which(M) of Special when is_atom(Special) -> do_normalized_paths(Ms); File when is_list(File) -> File = filename:join([File]), do_normalized_paths(Ms) end; do_normalized_paths([]) -> ok. %%----------------------------------------------------------------- %% error_logger handler. %% (Copied from stdlib/test/proc_lib_SUITE.erl.) %%----------------------------------------------------------------- init(Tester) -> {ok, Tester}. handle_event({warning_msg, _GL, Msg}, Tester) -> Tester ! Msg, {ok, Tester}; handle_event(_Event, State) -> {ok, State}. handle_info(_, State) -> {ok, State}. handle_call(_Query, State) -> {ok, {error, bad_query}, State}. terminate(_Reason, State) -> State. %%% %%% Common utility functions. %%% start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). stop_node(Node) -> test_server:stop_node(Node).