1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(multi_load_SUITE).
22-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
23	 init_per_group/2,end_per_group/2,
24	 basic_atomic_load/1,basic_errors/1,sticky_dir/1,
25	 on_load_failing/1,ensure_modules_loaded/1,
26	 native_code/1]).
27
28-include_lib("common_test/include/ct.hrl").
29-include_lib("syntax_tools/include/merl.hrl").
30
31suite() ->
32    [{ct_hooks,[ts_install_cth]},
33     {timetrap,{minutes,1}}].
34
35all() ->
36    [basic_atomic_load,basic_errors,sticky_dir,on_load_failing,
37     ensure_modules_loaded,native_code].
38
39groups() ->
40    [].
41
42init_per_suite(Config) ->
43    Config.
44
45end_per_suite(_Config) ->
46    ok.
47
48init_per_group(_GroupName, Config) ->
49    Config.
50
51end_per_group(_GroupName, Config) ->
52    Config.
53
54basic_atomic_load(Config) ->
55    PrivDir = proplists:get_value(priv_dir, Config),
56    Dir = filename:join(PrivDir, multi_load_sticky_dir),
57    _ = file:make_dir(Dir),
58
59    OldPath = code:get_path(),
60    try
61	code:add_patha(Dir),
62	do_basic(Dir)
63    after
64	code:set_path(OldPath)
65    end,
66
67    ok.
68
69do_basic(Dir) ->
70    MsVer1_0 = make_modules(5, versioned_module(1)),
71    MsVer1 = [{M,filename:absname(F, Dir),Bin} || {M,F,Bin} <- MsVer1_0],
72    _ = [ok = file:write_file(F, Bin) || {_,F,Bin} <- MsVer1],
73
74    Ms = [M || {M,_,_} <- MsVer1],
75    [] = [loaded || M <- Ms, is_loaded(M)],
76
77    ok = code:atomic_load(Ms),
78    _ = [1 = M:M() || M <- Ms],
79    _ = [F = code:which(M) || {M,F,_} <- MsVer1],
80    [] = [not_loaded || M <- Ms, not is_loaded(M)],
81
82    MsVer2 = update_modules(Ms, versioned_module(2)),
83    {ok,Prepared} = code:prepare_loading(MsVer2),
84    ok = code:finish_loading(Prepared),
85    _ = [2 = M:M() || M <- Ms],
86    _ = [F = code:which(M) || {M,F,_} <- MsVer2],
87    [] = [not_loaded || M <- Ms, not is_loaded(M)],
88
89    MsVer3 = update_modules(Ms, versioned_module(2)),
90    NotPurged = lists:sort([{M,not_purged} || M <- Ms]),
91    NotPurged = atomic_load_error(MsVer3, true),
92
93    ok.
94
95versioned_module(Ver) ->
96    fun(Mod) ->
97	    ?Q(["-module('@Mod@').\n",
98		"-export(['@Mod@'/0]).\n",
99		"'@Mod@'() -> _@Ver@.\n"])
100    end.
101
102basic_errors(_Config) ->
103    atomic_load_fc([42]),
104    atomic_load_fc([{"mod","file","bin"}]),
105
106    finish_loading_fc(atom),
107    {ok,{PrepTag,_}} = code:prepare_loading([code]),
108    finish_loading_fc({PrepTag,[x]}),
109    finish_loading_fc({PrepTag,[{m,{<<>>,"",<<>>}}]}),
110    Prep = prepared_with_wrong_magic_bin(),
111    finish_loading_fc(Prep),
112
113    [{x,badfile}] = atomic_load_error([{x,"x",<<"bad">>}], false),
114    [{a,badfile},{some_nonexistent_file,nofile}] =
115	atomic_load_error([some_nonexistent_file,{a,"a",<<>>}],
116			  false),
117
118    %% Modules mentioned more than once.
119    Mods = make_modules(2, fun basic_module/1),
120    Ms = [M || {M,_,_} <- Mods],
121    DupMods = Mods ++ [mnesia] ++ Mods ++ [mnesia],
122    DupErrors0 = lists:sort([mnesia|Ms]),
123    DupErrors = [{M,duplicated} || M <- DupErrors0],
124    DupErrors = atomic_load_error(DupMods, false),
125
126    ok.
127
128atomic_load_fc(L) ->
129    {'EXIT',{function_clause,[{code,atomic_load,[L],_}|_]}} =
130	(catch code:atomic_load(L)),
131    {'EXIT',{function_clause,[{code,prepare_loading,[L],_}|_]}} =
132	(catch code:prepare_loading(L)).
133
134finish_loading_fc(Term) ->
135    {'EXIT',{function_clause,[{code,finish_loading,[Term],_}|_]}} =
136	(catch code:finish_loading(Term)).
137
138prepared_with_wrong_magic_bin() ->
139    {ok,Prep} = code:prepare_loading([?MODULE]),
140    prep_magic(Prep).
141
142prep_magic([H|T]) ->
143    [prep_magic(H)|prep_magic(T)];
144prep_magic(Tuple) when is_tuple(Tuple) ->
145    L = prep_magic(tuple_to_list(Tuple)),
146    list_to_tuple(L);
147prep_magic(Ref) when is_reference(Ref) ->
148    try erlang:has_prepared_code_on_load(Ref) of
149	false ->
150	    %% Create a different kind of magic ref.
151	    ets:match_spec_compile([{'_',[true],['$_']}])
152    catch
153	_:_ ->
154	    Ref
155    end;
156prep_magic(Other) ->
157    Other.
158
159sticky_dir(_Config) ->
160    Mod0 = make_module(lists, fun basic_module/1),
161    Mod1 = make_module(gen_server, fun basic_module/1),
162    Ms = [Mod0,Mod1],
163    SD = sticky_directory,
164    StickyErrors = [{gen_server,SD},{lists,SD}],
165    StickyErrors = atomic_load_error(Ms, true),
166
167    ok.
168
169on_load_failing(_Config) ->
170    OnLoad = make_modules(1, fun on_load_module/1),
171    [{OnLoadMod,_,_}] = OnLoad,
172    Ms = make_modules(10, fun basic_module/1) ++ OnLoad,
173
174    %% Fail because there is a module with on_load in the list.
175    on_load_failure(OnLoadMod, Ms),
176    on_load_failure(OnLoadMod, [lists:last(Ms)]),
177
178    %% Fail because there already is a pending on_load.
179    [{HangingOnLoad,_,_}|_] = Ms,
180    spawn_hanging_on_load(HangingOnLoad),
181    NoOnLoadMs = lists:droplast(Ms),
182    {error,[{HangingOnLoad,pending_on_load}]} =
183	code:atomic_load(NoOnLoadMs),
184    hanging_on_load ! stop_hanging_and_unload,
185
186    ok.
187
188on_load_failure(OnLoadMod, Ms) ->
189    [{OnLoadMod,on_load_not_allowed}] = atomic_load_error(Ms, false).
190
191spawn_hanging_on_load(Mod) ->
192    {Mod,Name,Bin} = make_module(Mod, "unknown",
193				 fun(_) ->
194					 hanging_on_load_module(Mod)
195				 end),
196    spawn_link(fun() ->
197		       {error,on_load_failure} =
198			   code:load_binary(Mod, Name, Bin)
199	       end).
200
201hanging_on_load_module(Mod) ->
202    ?Q(["-module('@Mod@').\n",
203	"-on_load(hang/0).\n",
204	"hang() ->\n"
205	"  register(hanging_on_load, self()),\n"
206	"  receive _ -> unload end.\n"]).
207
208ensure_modules_loaded(Config) ->
209    PrivDir = proplists:get_value(priv_dir, Config),
210    Dir = filename:join(PrivDir, multi_load_ensure_modules_loaded),
211    _ = file:make_dir(Dir),
212
213    OldPath = code:get_path(),
214    try
215	code:add_patha(Dir),
216	do_ensure_modules_loaded(Dir)
217    after
218	code:set_path(OldPath)
219    end,
220
221    ok.
222
223do_ensure_modules_loaded(Dir) ->
224    %% Create a dummy "lists" module and place it in our code path.
225    {lists,ListsFile,ListsCode} = make_module(lists, fun basic_module/1),
226    ok = file:write_file(filename:absname(ListsFile, Dir), ListsCode),
227    {error,sticky_directory} = code:load_file(lists),
228
229    %% Make a new module that we can load.
230    Mod = make_module_file(Dir, fun basic_module/1),
231    false = is_loaded(Mod),
232
233    %% Make a new module with an on_load function.
234    OLMod = make_module_file(Dir, fun on_load_module/1),
235    false = is_loaded(OLMod),
236
237    %% lists should not be loaded again; Mod and OLMod should be
238    %% loaded.  ?MODULE should not be reloaded, but there is no easy
239    %% way to test that.  Repeating modules is OK.
240    ok = code:ensure_modules_loaded([?MODULE,lists,Mod,OLMod,
241				     Mod,OLMod,Mod,lists]),
242    last = lists:last([last]),
243    true = is_loaded(Mod),
244    ok = Mod:Mod(),
245    true = is_loaded(OLMod),
246    _ = OLMod:module_info(),
247
248    %% Unload the modules that were loaded.
249    [begin
250	 code:purge(M),
251	 code:delete(M),
252	 code:purge(M),
253	 false = is_loaded(M)
254     end || M <- [Mod,OLMod]],
255
256    %% If there are some errors, all other modules should be loaded
257    %% anyway.
258    [{BadMod,BadFile,_}] = make_modules(1, fun basic_module/1),
259    ok = file:write_file(filename:absname(BadFile, Dir), <<"bad_code">>),
260    BadOLMod = make_module_file(Dir, fun failing_on_load_module/1),
261    BadEgg = bad__egg,
262    NativeMod = a_native_module,
263    NativeModFile = atom_to_list(NativeMod) ++ ".beam",
264    {NativeMod,_,NativeCode} = make_module(NativeMod, NativeModFile,
265					   fun basic_module/1, [native]),
266    ok = file:write_file(filename:absname(NativeModFile, Dir), NativeCode),
267    ModulesToLoad = [OLMod,?MODULE,Mod,BadOLMod,NativeMod,
268		     BadEgg,BadMod,lists],
269    {error,Error0} = code:ensure_modules_loaded(ModulesToLoad),
270    Error = lists:sort([{BadEgg,nofile},
271			{BadMod,badfile},
272			{BadOLMod,on_load_failure}]),
273    Error = lists:sort(Error0),
274    true = is_loaded(Mod),
275    true = is_loaded(OLMod),
276    true = is_loaded(NativeMod),
277
278    ModuleNative = case erlang:system_info(hipe_architecture) of
279		       undefined -> false;
280		       _ -> true
281		   end,
282    ModuleNative = NativeMod:module_info(native),
283
284    ok.
285
286failing_on_load_module(Mod) ->
287    ?Q(["-module('@Mod@').\n",
288	"-on_load(f/0).\n",
289	"f() -> fail.\n"]).
290
291native_code(_Config) ->
292    case erlang:system_info(hipe_architecture) of
293	undefined ->
294	    {skip,"No native support"};
295	_ ->
296	    do_native_code()
297    end.
298
299do_native_code() ->
300    CalledMod = native_called_module,
301    CallingMod = native_calling_module,
302
303    %% Create a module in native code that calls another module.
304    CallingMod = make_and_load(CallingMod,
305			       calling_module_fun(CalledMod),
306			       [native]),
307
308    %% Create a threaded-code module.
309    _ = make_and_load(CalledMod, called_module_fun(42), []),
310    42 = CallingMod:call(),
311
312    %% Now replace it with a changed module in native code.
313    code:purge(CalledMod),
314    make_and_load(CalledMod, called_module_fun(43), [native]),
315    true = test_server:is_native(CalledMod),
316    43 = CallingMod:call(),
317
318    %% Reload the called module and call it.
319    code:purge(CalledMod),
320    ModVer3 = make_module(CalledMod, "", called_module_fun(changed)),
321    ok = code:atomic_load([ModVer3]),
322    false = test_server:is_native(CalledMod),
323    changed = CallingMod:call(),
324    code:purge(CalledMod),
325
326    ok.
327
328make_and_load(Mod, Fun, Opts) ->
329    {Mod,_,Code} = make_module(Mod, "", Fun, Opts),
330    {module,Mod} = code:load_binary(Mod, "", Code),
331    Mod.
332
333calling_module_fun(Called) ->
334    fun(Mod) ->
335	    ?Q(["-module('@Mod@').\n",
336		"-export([call/0]).\n",
337		"call() -> _@Called@:f().\n"])
338    end.
339
340called_module_fun(Ret) ->
341    fun(Mod) ->
342	    ?Q(["-module('@Mod@').\n",
343		"-export([f/0]).\n",
344		"f() -> _@Ret@.\n"])
345    end.
346
347%%%
348%%% Common utilities
349%%%
350
351atomic_load_error(Modules, ErrorInFinishLoading) ->
352    {error,Errors0} = code:atomic_load(Modules),
353    {Errors1,Bool} =
354	case code:prepare_loading(Modules) of
355	    {ok,Prepared} ->
356		{error,Es0} = code:finish_loading(Prepared),
357		{Es0,true};
358	     {error,Es0} ->
359		{Es0,false}
360	end,
361    Errors = lists:sort(Errors0),
362    Errors = lists:sort(Errors1),
363    case {ErrorInFinishLoading,Bool} of
364	{B,B} ->
365	    Errors;
366	{false,true} ->
367	    ct:fail("code:prepare_loading/1 should have failed");
368	{true,false} ->
369	    ct:fail("code:prepare_loading/1 should have succeeded")
370    end.
371
372is_loaded(Mod) ->
373    case erlang:module_loaded(Mod) of
374	false ->
375	    false = code:is_loaded(Mod);
376	true ->
377	    {file,_} = code:is_loaded(Mod),
378	    true
379    end.
380
381basic_module(Mod) ->
382    ?Q(["-module('@Mod@').\n"
383	"-export(['@Mod@'/0]).\n",
384	"'@Mod@'() -> ok."]).
385
386on_load_module(Mod) ->
387    ?Q(["-module('@Mod@').\n",
388	"-on_load(f/0).\n",
389	"f() -> ok.\n"]).
390
391make_module_file(Dir, Fun) ->
392    [{Mod,File,Code}] = make_modules(1, Fun),
393    ok = file:write_file(filename:absname(File, Dir), Code),
394    Mod.
395
396make_modules(0, _) ->
397    [];
398make_modules(N, Fun) ->
399    U = erlang:unique_integer([positive]),
400    ModName = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U),
401    Mod = list_to_atom(ModName),
402    ModItem = make_module(Mod, Fun),
403    [ModItem|make_modules(N-1, Fun)].
404
405update_modules(Ms, Fun) ->
406    [make_module(M, Fun) || M <- Ms].
407
408make_module(Mod, Fun) ->
409    Filename = atom_to_list(Mod) ++ ".beam",
410    make_module(Mod, Filename, Fun).
411
412make_module(Mod, Filename, Fun) ->
413    make_module(Mod, Filename, Fun, []).
414
415make_module(Mod, Filename, Fun, Opts) ->
416    Tree = Fun(Mod),
417    merl:print(Tree),
418    {ok,Mod,Code} = merl:compile(Tree, Opts),
419    {Mod,Filename,Code}.
420